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CONT  OF  BLOCK  13: 


The  model  is  accompanied  by  an  application  program  that  allows 
specification  of  fluxes  at  an  arbitrary  point  in  the  magnetosphere 
within  the  modeling  region.  Consistent  with  its  primary  function, 
the  MSM  has  been  tested  against  spacecraft  data  for  2  substantial 
storms  and  has  been  shown  to  produce  a  good  characterization  of  the 
enhancements  of  40  KeV  electron  fluxes  in  the  equatorial  plane. 
The  model  never  failed  to  predict  high  fluxes  when  they  were 
observed,  although  it  did  predict  high  fluxes  in  some  cases  when 
they  were  not  observed  and  it  did  fail  to  predict  flux  dropouts 
observed  by  the  spacecraft.  The  MSM  is  ready  for  adaptation  for 
use  in  an  operational  setting  where  the  goal  is  real-time  and 
retrospective  specification  of  hazardous  charged  particle  fluxes 
associated  with  geomagnetic  storms. 
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Appendix 


FUNCTIONAL  DESCRIPTION 


FUNCTIONAL  DESCRIPTION  -  1 


Funcrional  Description 


2.2  Objectives.  The  Magnetospheric  Specification  Model  was  developed  as  a  set  of  algorighms  to 
be  developed  into  a  real-time  program  for  use  in  the  Space  Forecast  Center  operated  by  the  Air 
Weather  Service  of  the  U.S.  Air  Force.  It  is  intended  to  help  the  Center  personnel  perform  their 
mission  of  providing  information,  particularly  during  magnetospheric  disturbances,  to  "customers" 
who  operate  spacecraft  The  ou^ut  of  the  m^el  includes  (but  is  not  limited  to): 

1)  Fluxes  of  electrons  and  ions  in  the  inner  plasma  sheet  and  the  geosynchronous  orbit 
region. 

2)  Energy  fluxes  and  characteristic  energies  of  electrons  precipitated  into  the  auroral 
ionosphere. 


2.4  Proposed  Methods  and  Procedures. 

The  most  sophisticated  type  of  theoretical  inner-magnetosphere/ionosphere  model  is  exemplified  by 
the  Rice  Convection  Model  (RCM).  However,  the  Air  Force  requirement  for  near-real  time  data 
output  and  the  relatively  slow  run-time  of  the  RCM  made  it  unsuitable  for  Air  Force  opertional  use. 
With  these  constraints  in  mind  we  dropped  the  self-consistent  treatment  and  have  separate 
ionospheric  electric  field  and  magnetospheric  magnetic  field  models  to  trace  particles  in  the 
magnetosphere  equatorial  plane  (See  attached  flow  chart).  The  magnetic  field  model  provides  the 
mapping  between  the  two  regions  with  the  condition  that  the  equatorward  edge  of  the  auroral  zone 
in  the  ionosphere  maps  to  the  inner  edge  of  the  plasma  sheet  in  the  magnetospheric  equatorial 
plane. 


3.1  Specific  Performance  Requirements. 

The  output  of  the  model  includes  fluxes  of  electrons  and  ions  in  the  inner  plasma  sheet  and  the 
geos^chronous  orbit  region  and  energy  fluxes  and  characteristic  energies  of  the  electrons  and  ions 
precipitated  into  the  ionosphere.  The  tluoughput  time  will  vary  depenSng  on  the  number  and 
energy  of  particles  traced,  as  well  as  the  length  of  time  for  which  the  model  is  to  be  run. 


3.2.1  Accuracy  and  Validity.  The  Magnetospheric  Specification  Model  produces  the  most  accurate 
and  reliable  specifications  possible  given  the  available  input  parameters  and  the  state  of 
magnetospheric  science.  The  standard  deviation  of  the  model  fluxes  and  available  observed 
geosynchronous  satellite  data  is  output  after  each  run. 


3.2.2  Timing.  Attached  is  a  report  on  the  throughput  time  on  the  IBM  3081  computer.  All  input 
data  for  the  run  will  acquired  from  the  operational  Environmental  Database  at  the  beginning  of  the 
run  as  shown  on  the  MSM  Control  and  Data  Flow  Diagram.  All  output  data  will  be  returned  to  the 
Environmental  Database. 
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3.2  Functional  Area  System  Functions.The  major  components  of  the  system  are: 

MSMCON  Main  program  -  sets  start,  ending,  and  time  steps  for  the  run 

PPTCON  Executive  routine  to  control  flow  of  Magnetospheric  Specification  Model 

EBCON  Executive  routine  to  control  calculation  of  electric  and  magnetic  field  models 

PPTM  Subroutine  to  trace  particle  trajectories  from  each  grid  point  for  each  particle 
species  back  in  time  from  time  =  TSTART  to  time  =  TSTOP 

Attached  is  flow  chart  of  each  of  the  major  components. 


Following  is  input  within  the  program: 

ISTART(l)  Start  Year  (last  two  digits) 

ISTART(2)  Start  Day  (julian  day).  January  1  is  day  1. 

ISTART(3)  Start  Time  (seconds) 

IEND(  1 )  End  Year  Cast  two  digits) 

IEND(2)  End  Day  (julian  day)  January  1  is  day  1. 

IEND(2)  End  Time  (seconds) 

IINC(  1 )  Program  time  step  increment  (year) 

IINC(2)  Program  time  step  increment  (day) 

IINC(3)  Program  time  step  increment  (seconds) 

IRECEB  For  restart,  record  number  of  previously  calculated  electric  and  magnetic  field 
output  data  to  use  as  input  for  current  run 

IRECPT  For  restart,  record  number  of  previously  calculated  particle-trace  output  data  to 
use  as  input  for  current  run 


Following  are  the  input  files  required,  including  those  to  be  replace  by  calls  to  the  environmental 
data  base; 


BOxxxxxx  The  magnetic  field  matrices  needed  for  the  model  run. 

(XAPSE  File  containing  values  giving  the  collapse/no  collapse  state  of  the 

magnetosphere.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete. 

COORD  File  of  values  to  set  up  the  coordinate  system. 

DST  Dst  values  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data 

base,  when  complete  (nT). 

EFCOEF  Coefficients  from  Heppner-Maynard  model  which  are  input  to  the  electric  field 

model. 
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ENCHAN 

EQEDGE 


FKP 

HARDY 

lONENG 

lONNUM 

PCP 


SWDEN 


SWVEL 


XIPATT 


Input  values  for  the  number  of  energy  channels,  particle 
ty^  and  energy  channels  for  the  m(^el  to  simulate. 

V^ues  of  the  equatorward  edge  of  the  auroral  oval  at  midnight  used  as  input 
into  the  electric  field  model.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (degrees). 

Kp  data  for  the  event.  To  be  replaced  by  call  to  AWS  environmental  data  base, 
when  complete. 

Coefficients  used  by  the  Hardy  precipitating  electron  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model, 
coefficients  used  as  input  for  the  ion  precipitating  model. 

Cross-polar  cap  potential  values  for  event  used  as  input  to  the  electric  field 
model.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete  (kV). 

Solar  wind  density  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(particles/cm^) 

Solar  wind  velocity  values  us  .d  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(km/sec) 

Polar  cap  pattern  type  used  as  input  to  electric  field  model  for  the  event.  To  be 
replaced  by  call  to  AWS  environmental  data  base,  when  complete. 


Following  are  the  output  files; 


V 

VNORTH 

VSOUTH 

VM 

BMIN 

XMIN 

YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 


EAVG 

AUGPAR 

COLAT 

ALOCT 

FLUX 


Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts). 

Northern  hemisphere  electric  potential  distribution  (Volts). 

Southern  hemisphere  electric  potential  distribution  (Volts). 

Flux  tube  volume  ((Re/nT)'2/3). 

Equatorial  magnetic  field  strength  (nT). 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Location  of  outer  boundary  of  detailed  particle  traces. 

Precipitating  energy  flux  array  (ergs/cm^-sec). 

Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  H'*’  and  (3)  O'*")  (ergs/cm^-sec). 

Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H"*"  and  (3)  0'*’(eV). 
Augmented  data  array  for  input  values. 

Grid  colatitude  array  (radians). 

Grid  local  time  array  (radians  eastward  from  noon). 

Flux  values  for  all  energy  channels  at  all  grid  points 


MSMCON 

Main  MSM  control  program 


PPTCON 

Subroutine  that  controls  the  major  computations  of  the  MSM. 
This  routine  calls  EBCON  to  construct  E  and  B  field  matrices  at 
mark  times  and  then  proceeds  to  trace  particle  trajectories  from 
each  grid  point  for  each  mark  time. 


Set  up  grid 

Initialize  matrix  of  Kp-dependent  default  fluxes 
Set  up  energy  channels  to  be  modeled 
Initialize  matrix  of  Kp-dependent  default  fluxes 

Compute  E  and  B  field  arrays  for  all  mark  times 

Compute  time-dependent  plasma  boundary 
conditions  for  all  mark  times 


If  results  from  previous  run  are  available,  read 
these  results  to  set  initial  plasma  distribution 

Set  initial  plasma  distribution 
Start  main  particle  trace  time  loop 

If  there  is  enough  input  data 
Do  full  particle  traces 
Else 

Invoke  default  Kp-based  particle 
distribution 
End  if 

Calculate  precipitating  electron  and  ion 
fluxes  from  Hardy  inodels 

Write  results  to  archive  files 

Copy  current  values  in  ETA  to  ETABEG 
End  main  particle  trace  time  loop 

Return 


EBCON 

Calculate  E  and  B  field  arrays  at  grid  points  for  mark  times 


PPTM 

Subroutine  to  trace  particle  trajectories  from  each  grid  point 
for  each  particle  species  back  in  time  one  major  time  step  from 
time  =  TSTART  to  time  =  TSTOP.  (TSTART  >  TSTOP) 


Calculate  reference  flux  array 
Loop  over  all  particle  species 


SETREF 


Loop  over  all  grid  points 

Determine  normalized  time  BBT 

Set  ETA  to  boundary  value  of  eta  for 
points  outside  of  boundary 

Calculate  locations  and  energies  at 
TSTART 

Start  adaptive  Runge-Kuttatime  loop 

Move  particle  a  time  step  and 

increment  time 

Interpolate  to  find  location,  flux 
tube  volume  and  energy  at  end 
of  small  RK  time  step 

Calculate  loss  rate  this  time  step 

If  time  boundary  is  crossed 
(ie.,  T<TSTOP)  exit  Runge-Kutta 
time  loop 

If  spatial  boundary  is  crossed 
exit  Runge-Kutta  time  loop 


Else  go  to  beginning  of  Runge- 
Kutta  time  loop 


End  of  Runge-Kutta  time  loop 

Calculate  ETA  at  grid  point  from 
traceback  and  loss  information. 

ETA  is  not  allowed  to  drop  below 
equilibrium  flux  value.  Loss  depends 
on  threshold  for  strong  pitch  angle 
scattering. 


Calculate  precipitating  flux  and  energy 


End  loop  over  grid  points 


End  loop  over  species 


Return 
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System/Subsystem  Specification 


2. 1  System/Subsvstem  Description.  Attached  is  a  flow  chart  of  the  major  components  of  the 
Magnetospheric  Specification  Model.  The  major  components  of  the  model  are  MSMCON, 
PPTCON,  EBCON,  and  PPTM. 


2.2  Svstem/Subsvstem  Functions. 


MSMCON 

PPTCON 

EBCON 

PPTM 


Main  program  -  sets  start,  ending,  and  time  steps  for  the  run 

Executive  routine  to  control  flow  of  Magnetospheric  Specification  Model 

Executive  routine  to  control  calculation  of  electric  and  magnetic  field  models 

Subroutine  to  trace  particle  trajectories  from  each  grid  point  for  each  particle 
species  back  in  time  from  time  =  TSTART  to  time  =  TSTOP 


2.2.1  Accuracy  and  Validity.  The  Magnetospheric  Specification  Model  produces  the  most  accurate 
and  reliable  specifications  possible  given  the  available  input  parameters  and  the  state  of 
magnetospheric  science.  The  standard  deviation  of  the  model  fluxes  and  available  observed 
geosynchronous  satellite  data  is  output  after  each  run. 


2.2.2  Timing.  Attached  is  a  report  on  the  throughput  time  on  the  IBM  3081  computer.  All  input 
data  for  the  run  will  acquired  from  the  operational  Environmental  Database  at  the  beginning  of  the 
run  as  shown  on  the  MSM  Control  and  Data  Flow  Diagram.  All  output  data  will  be  returned  to  the 
Environmental  Database.  No  file  interrogation  takes  place  during  the  run. 


4.3  System  Data.  The  following  files  are  necessary  to  restan  the  program: 


BOxxxxxx 

COORD 

EFCOEF 

ENCHAN 

FKP 

HARDY 

lONENG 

lONNUM 


The  magnetic  field  matrices  needed  for  the  model  run. 

File  of  values  to  set  up  the  coordinate  system. 

Coefficients  fixjm  Heppner-Maynard  model  which  are  input  to  the  electric  field 
model. 

Input  values  for  the  number  of  energy  channels,  particle  type  and  energy 
channels  for  the  model  to  simulate. 

Kp  data  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data  base, 
when  coriplete. 

Coefficients  used  by  the  Hardy  precipitating  electron  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 
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4.3.1  Inputs. 


Following  is  input  within  the  program: 


ISTART(l) 

ISTART(2) 

ISTART(3) 

lEND(l) 

IEND(2) 

IEND(2) 

IINC(l) 

IINC(2) 

IINC(3) 

IRECEB 

IRECPT 


Stan  Year  Oast  two  digits) 

Stan  Day  (Julian  day) 

Stan  Time  (seconds) 

End  Year  (last  two  digits) 

End  Day  (Julian  day) 

End  Time  (seconds) 

Program  time  increment  (year) 

Program  time  increment  (day) 

Program  time  increment  (seconds) 

For  restan,  record  number  of  previously  calculated  electric  and  magnetic  field 
output  data  to  use  as  input  for  current  run 

For  restart,  record  number  of  previously  calculated  particle-trace  output  data  to 
use  as  input  for  cunentrun 


Following  is  the  input  files  required,  including  those  to  be  replace  by  calls  to  the  environmental 
data  base: 


BOxxxxxx 

CLAPSE 


COORD 

DST 

EFCOEF 

ENCHAN 

EQEDGE 


FKP 

HARDY 

lONENG 

lONNUM 

PCP 


The  magnetic  field  matrices  needed  for  the  model  run. 

File  containing  values  giving  the  collapse/no  collapse  state  of  the 
magnetosphere.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete. 

File  of  values  to  set  up  the  coordinate  system. 

Dst  values  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (nT). 

Ckiefficients  from  Heppner-Maynard  model  which  are  input  to  the  electric  field 
model. 

Input  values  for  the  number  of  energy  channels,  particle 
type  and  energy  channels  for  the  m^el  to  simulate. 

Values  of  the  equatorwaid  edge  of  the  auroral  oval  at  midnight  used  as  input 
into  the  electric  field  model.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (degrees). 

Kp  data  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data  base, 
when  complete. 

Coefficients  used  by  the  Hardy  precipitating  electron  model. 

C]!oefficients  used  as  input  for  the  ion  precipitating  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

Cross-polar  cap  potential  values  for  event  used  as  input  to  the  electric  field 
model.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete  (kV). 
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SWDEN 

SWVEL 

XIPATT 

4.3.2  Quipaiis. 
V 

VNORTH 

VSOUTH 

VM 

BMIN 

XMIN 

YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 


Solar  wind  density  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(particles/cm^) 

Solar  wind  velocity  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(km/sec) 

Polar  cap  pattern  type  used  as  input  to  electric  field  model  for  the  event.  To  be 
replaced  by  call  to  AWS  environmental  data  base,  when  complete. 


The  following  files  are  output: 

Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Northern  hemisphere  electric  potential  distribution  (Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  numbCT  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Southern  hemisphere  electric  potential  distribution  (Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  numb^  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Hux  tube  volume  ((Re/nT)'2/3). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  step3  x  4  (bytes) 

Equatorial  magnetic  field  stren^  (nT). 

Output  volume  •  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  ^ytes) 

Location  of  outer  boundary  of  detailed  particle  traces. 

Output  volume  -  number  of  longitudinal  gridpoints  x  number  of  time  steps  x  4 
(bytes) 

Prwipitating  energy  flux  array  (ergs/cm^-sec). 

Output  volume  -  number  of  latituthnal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 
Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
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EAVG 

AUGPAR 

COLAT 

ALOCr 

FLUX 


(2)  H+  and  (3)  0+)  (ergs/cm^-sec). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H"*"  and  (3)  O'^(eV). 
Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Augmented  data  array  for  input  values. 

Output  volume  -number  of  data  elements  x  number  of  time  steps  x  4  (bytes) 
Grid  colatitude  array  (radians). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Grid  local  time  array  (radians  eastward  from  noon). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Flux  values  for  all  energy  channels  at  all  grid  points 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 


4.3.3  natahacpynafa  Rank  The  attached  chart  lists  the  parameter  inputs  from  the  operational 
Environmental  Database  and  a  proposed  data  transfer  method. 


4.4  Software  Unit  Descriptions. 


4.4. 1  MSMCON  -  see  attached  flow  chart. 

PPTCON  Main  control  program  for  model 

HIEPAR  High  energy  electron  subroutine,  currently  a  dummy  routine  pending  computer 
code  from  Dan  Baker,  GSFC 


4.4.2  PPTCON  -  see  attached  flow  chart. 

RDGRID  Subroutine  to  read  grid  system  coordinates  and  calculate  essential  grid  quantities 
OUTP  Utility  subroutine  to  print  out  array  information 
FI.XNIT  Subroutine  to  calculate  Kp-based  particle  number  flux  in  units  of 
particles/cmVs/sr/eV  as  function  of  R,  energy  and  Kp 
DTIME  Routine  which  returns  current  system  time 

EBCON  Executive  routine  to  control  calculation  of  electric  and  magnetic  field  models 
EPREAD  Dummy  routine  to  read  satellite  flux  data  -  to  be  replaced  by  call  to 
environmental  data  base  when  program  is  operational 
SETALM  Subroutine  to  read  the  number  of  energy  channels  and  their  energies  at 

geosynchronous  orbit  and  calculate  the  energy  invariant  species  needed  to  run 
^e  program 
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BNDSET  Subroutine  to  compute  boundary  plasma  distribution 

RDHDR  Subroutine  to  read  the  headar  record  of  the  standard  MSM  disk  file  format 

INTTAL  Subroutine  to  compute  initial  plasma  distribution 

PPTM  Subroutine  to  trace  particle  trajectories  from  each  grid  point  for  each  particle 
species  back  in  time  from  time=TSTART  to  time=TSTOP 
FLXDFL  Subroutine  to  calculate  the  energy-dependent  ETA  array  from  Kp  and  the 

location  of  the  grid  points  by  interpolating  the  empirical  FLXMAT  array  -  this 
routine  is  used  as  the  MSM  default  model  when  full  particle  traces  are  not  done 
AURLl  Subroutine  to  determine  default  Hardy  precipitating  electron  flux 

AURL2S  Subroutine  to  determine  default  Hardy  precipitating  ion  flux 
PWRCAL  Subroutine  to  estimate  precipitating  electron  energy  flux  poleward  of  the  main 
MSM  modeling  region  by  comparing  flux  within  modeling  region  with  Hardy 
statistical  values 

WRT3D  Subroutine  to  write  3-d  arrays  into  the  standard  MSM  disk  file  format 


4.4.3  EBCON  -  see  attached  flow  chart. 

FECON  Subroutine  to  obtain  time-normalized  observational  values 
MLTSET  Subroutine  to  calculate  time  dependent  ALOCT  of  rotating  grid  points 

SETSCT  Subroutine  to  set  species  dependent  pitch  angle  scattering  efficiency 
BTRACE  Subroutine  to  calculate  magnetic  field  models  appropriate  for  geophysical 

conditions  as  specified  by  standoff  distance,  equatorward  edge  of  the  auroral 
zone,  Ost,  tail  collapse,  and  tilt  angle 

EFBNDY  Subroutine  to  calculate  latitudes  and  widths  of  electric  field  model  boundarys  2 
and  3 

EFIELD  Subroutine  to  return  values  of  the  potential  on  the  northern  hemisphere  grid 

(VNORTH),  on  the  southern  hemisphere  grid  (VSOUTH),  and  the  average  of 
the  two  hemispheres  (V) 

OUTP  Utility  subroutine  to  print  out  array  information 
FNDBND  Subroutine  to  compute  time  dependent  outer  boundary  location 
G3NTRP  Utihty  function  subprogram  to  perform  a  general  3-d  linear  interpolation  of  an 
arbitrary  array  A(I,J,K)  at  point  (BI,BJ,BK) 

VMLSET  Subroutine  to  calculate  VNLOSS  array 

WRT3D  Subroutine  to  write  3-d  arrays  into  the  standard  MSM  disk  file  format 


4.4.4  PPTM  -  see  attached  flow  chart. 


SETREF 

OUTP 

TNORML 

G3NTRP 

WKRATE 

MOVER 


Subroutine  to  set  upper  limit  reference  flux 

Utihty  routine  to  print  our  array  information 

Utihty  function  subprogram  to  calculate  run-normalized  time 

Utility  function  subprogram  to  perform  a  general  3-d  linear  interpolation  of  an 

arbitr^  array  A(I  j,K)  at  point  (BI,BJ,BK) 

Function  subprogram  to  evaluate  weak  precipitation  loss  rate 
Subroutine  to  advance  one  particle  location  one  time  step  using  4th-order 
Runge-Kutta  algorithm  with  5th  order  correction 
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MODFDC 

TCHK 

BNDCHK 

FLXVAL 


Subroutine  to  adjust  BBJ  to  be  between  2  and  JDIM-1 

Subroutine  to  check  whether  time  boundary  was  crossed 

Subroutine  to  determine  whether  particle  has  crossed  boundary  of  calculation 

Function  subprogram  to  calculate  Kp-dependent  flux  value  a  R=RR  for  particles 

of  energy  ENRG  and  Kp=FKP  by  interpolating  FLXMAT  array 


PARAMETER  I  NAME  ]  UNITS  |K)|  TimcTag  |  Geo.  Latitude  I  Geo.  Loneitude  I  Altitude 


P«ge 


Data  Transfer  Method 


1 .  MSM  will  access  the  environmental  database  input  data  files 
by  calling  a  subroutine,  INDATA. 

2.  ’liie  call  will  be  of  the  form: 

CALL  INDATA(pann-name,  STARTT,  ENDT,  NDIM,  DARRY, 

NUMNUM) 

Where: 

parm-name  is  a  valid  par^eter  name  from  the  MSM  input  parameter  list 
STARTT  is  the  starting  time  for  this  data  request. 

ENDT  is  the  ending  time  for  this  data  request. 

NDIM  is  the  horizontal  dimension  of  DARRYand  the  maximum  number  of  data 
points  that  may  be  returned. 

DARRY  is  a  two  dimensional  array  to  be  retrieved 

from  the  database.  The  form  of  DARRY  is  shown  on  the  next  page.  The  size  of 
DARRY  will  be  NDIM  by  7. 

NUMNUM  is  the  number  of  data  values  placed  in  DARRY  by  INDATA. 

3.  The  system  controller  will  periodically  update  the  input 
data  files. 

4.  Rice  does  not  plan  to  write  INDATA. 

5.  All  parameters  will  be  in  single  precision,  floating  point  format. 

6.  Output  data  will  be  passed  from  MSM  to  the  environmental 
database  via  a  subroutine,  OTDATA. 

7.  The  call  to  OTDATA  will  be  defined  similarly  to  INDATA. 

8.  Rice  does  not  plan  to  write  OTDATA. 


Format  for  DARRY 


NDIM  - ► 


Data  value  at  t1 

Data  value  at  t2 

Data  value  at  t3 

Etc. 

Time  tag  at  t1 

Time  tag  at  t2 

Time  tag  at  t3 

Latitude 

Latitude 

Latitude 

Longitude 

Longitude 

Longitude 

Altitude 

Altitude 

Altitude 

mag.  local  time 

mag.  local  time 

mag.  local  time 

jwf  March  14,  1989 


MSMCON 

Main  MSM  control  program 


PARAMETER  statement  for  array  sizes 
DIMENSION  statements  for  all  variables 
Set  starting  and  ending  times 
Perform  major  computations 
Access  high  energy  module 
STOP 


PPTCON 


HIEPAR 


I 

I 

I 

I 


PPTCON 

Subroutine  that  controls  the  major  computations  of  the  MSM. 
This  routine  calls  EBCON  to  construct  E  and  B  field  matrices  at 
mark  times  and  then  proceeds  to  trace  particle  trajectories  from 
each  grid  point  for  each  mark  time. 


Set  up  grid 

Initialize  matrix  of  Kp-dependent  default  fluxes 
Set  up  energy  channels  to  be  modeled 


RDGRID 


SETALM 


Initialize  matrix  of  Kp-dependent  default  fluxes 


FLXNIT 


Compute  E  and  B  field  arrays  for  all  mark  times 


EBCON 


Compute  time-dependent  plasma  boundary 
conditions  for  all  mark  times 


BNDSET 


If  results  from  previous  run  are  available,  read 
these  results  to  set  initial  plasma  distribution 


RDHDR 


READ3D 


Set  initial  plasma  distribution 
Start  main  particle  trace  time  loop 

If  there  is  enough  input  data 
Do  full  particle  traces 


INITAL 


PPTM 


Invoke  default  Kp-based  particle 
distribution 
End  if 

Calculate  precipitating  electron  and  ion 
fluxes  from  Hardy  models 


FLXDFL 


AURL1 


AURL2S 


Write  results  to  archive  files 


Copy  current  values  in  ETA  to  ETABEG 


End  main  particle  trace  time  loop 


WRT3D 


Return 


EBCON 

Calculate  E  and  B  field  arrays  at  grid  points  for  mark  times 


Get  time-dependent  input  parameters  for  all  mark 
times 

Start  of  main  E  and  B  field  time  loop 

Set  local  time  array  ALOCT  to  correct  value 

Calculate  pitch  angle  scattering  rate  as 
fraction  of  strong  pitch  angle  scattering 

Output  the  AUGPAR  array  of  input  parameters 
Calculate  the  B  field  arrays  for  this  time 


Determine  boundaries  used  in  E  field 
calculation 


Calculate  electric  potential  arrays  for  this  time 


Determine  model  outer  boundary 


Output  E  and  B  field  results  to  archive  files 


End  of  E  and  B  field  time  loop 


Return 


PPTM 

Subroutine  to  trace  particle  trajectories  from  each  grid  point 
for  each  particle  species  back  in  time  one  major  time  step  from 
time  =  TSTART  to  time  =  TSTOP.  (TSTART  >  TSTOP) 


Calculate  reference  flux  array 
Loop  over  all  particle  species 

Loop  over  all  grid  points 

Determine  normalized  time  BBT 

Set  ETA  to  boundary  value  of  eta  for 
points  outside  of  boundary 

Calculate  locations  and  energies  at 
TSTART 

Start  adaptive  Runge-Kutta  time  loop 

Move  particle  a  time  step  and 
increment  time 

Interpolate  to  find  location,  flux 
tube  volume  and  energy  at  end 
of  small  RK  time  step 

Calculate  loss  rate  this  time  step 

If  time  boundary  is  crossed 
(ie.,  T<TSTOP)  exit  Runge-Kutta 
time  loop 

If  spatial  boundary  is  crossed 
exit  Runge-Kutta  time  loop 

Else  go  to  beginning  of  Runge- 
Kutta  time  loop 

End  of  Runge-Kutta  time  loop 

Calculate  ETA  at  grid  point  from 
traceback  and  loss  information. 

ETA  is  not  allowed  to  drop  below 
equilibrium  flux  value.  Loss  depends 
on  threshold  for  strong  pitch  angle 
scattering. 

Calculate  precipitating  flux  and  energy 
End  loop  over  grid  points 
End  loop  over  species 


SETREF 


TNORML 


G3NTRP 


MOVER 


G3NTRP 


TCHK 


BNDCHK 


Return 
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Software  Unit  Specification 


2.2  Software  Unit  Functions.  See  the  attached  pages  for  the  subroutine  names,  functions  and 
calling  environment 


2.2.1  Accuracy  and  Validity.  The  Magnetospheric  Specification  Model  produces  the  most  accurate 
and  reliable  specifications  possible  given  the  available  input  parameters  and  the  state  of 
magnetospheric  science.  The  standard  deviation  of  the  model  fluxes  and  available  observed 
geosynchronous  satellite  data  is  output  after  each  run. 


2.2.2  Timing.  Attached  is  a  report  on  the  throughput  time  on  the  IBM  3081  computer.  All  input 
data  for  the  run  will  acquired  from  the  operational  Environmental  Database  at  the  beginning  of  the 
run  as  shown  on  the  MSM  Control  and  Data  Flow  Diagram.  All  output  data  will  be  returned  to  the 
Environmental  Database.  No  file  interrogation  takes  place  during  the  run. 


4.3  Inputs. 

Following  is  input  within  the  program: 


ISTART(l) 

ISTART(2) 

ISTART(3) 

lEND(l) 

IEND(2) 

IEND(2) 

IINC(l) 

IINC(2) 

IINC(3) 

IRECEB 

IRECPT 


Start  Year  (last  two  digits) 

Start  Day  (julian  day) 

Start  Time  (seconds) 

End  Year  (last  two  digits) 

End  Day  (julian  day) 

End  Time  (seconds) 

Program  time  increment  (year) 

Program  time  increment  (day) 

Program  time  increment  (seconds) 

For  restart,  record  number  of  previously  calculated  electric  and  magnetic  field 
output  data  to  use  as  input  for  current  run 

For  restart,  record  number  of  previously  calculated  particle-trace  output  data  to 
use  as  input  for  current  run 


Following  is  the  input  files  required,  including  those  to  be  replace  by  calls  to  the  environmental 
database: 


The  magnetic  field  matrices  needed  for  the  model  run. 

File  containing  values  giving  the  collapse/no  collapse  state  of  the 
magnetosphere.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete. 


BOxxxxxx 

(XAPSE 


SOFTWARE  UNIT  SPECIFICATION  -  2 


COORD 

DST 

EFCOEF 

ENCHAN 

EQEDGE 

FKP 

HARDY 

lONENG 

lONNUM 

PCP 

SWDEN 

SWVEL 

XIPATT 

4.3  Outputs. 
V 

VNORTH 

VSOUTH 

VM 


File  of  values  to  set  up  the  coordinate  system. 

Dst  values  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (nT). 

Coefficients  from  Heppner-Maynard  model  which  are  input  to  the  electric  field 
model. 

Input  values  for  the  number  of  energy  channels,  particle 
type  and  energy  channels  for  the  mt^el  to  simulate. 

Vdues  of  the  equatorward  edge  of  the  auroral  oval  at  midnight  used  as  input 
into  the  electric  field  model.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (degrees). 

Kp  data  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data  base, 
when  complete. 

Coefficients  used  by  the  Hardy  precipitating  electron  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

Qoss-polar  cap  potential  values  for  event  used  as  input  to  the  electric  field 
model.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete  (kV). 

Solar  wind  density  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(particles/cm^) 

Solar  wind  velocity  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(km/sec) 

Polar  cap  pattern  type  used  as  input  to  electric  field  model  for  the  event.  To  be 
replaced  by  call  to  AWS  environmental  data  base,  when  complete. 


The  following  files  are  output: 

Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Northern  hemisphere  electric  potential  distribution  (Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Southern  hemisphere  electric  potential  distribution  (Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Flux  tube  volume  ((Re/nT)-2^). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
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BMIN 

XMIN 

YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 

EAVG 

AUGPAR 

COLAT 

ALOCT 

FLUX 


gridpoints  x  number  of  time  steps  x  4  (bytes) 

Equatorial  magnetic  field  strength  (nT). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Ouqrut  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Ouqjut  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Location  of  outer  boundary  of  detailed  particle  traces. 

Output  volume  -  number  of  longitudinal  gridpoints  x  number  of  time  steps  x  4 
(bytes) 

Precipitating  energy  flux  array  (ergs/cm^-sec). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 
Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  H+  and  (3)  0+)  (ergs/cm^-sec). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H'*’  and  (3)  0'''(eV). 
Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Augmented  data  array  for  input  values. 

Output  volume  -number  of  data  elements  x  number  of  time  steps  x  4  (bytes) 
Grid  colatitude  array  (radians). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Grid  local  time  array  (radians  eastward  from  noon). 

Output  volunK  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Flux  values  for  all  energy  channels  at  all  grid  points 
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Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 


MSM  Routines  by  Function 


Control  Routines 


Routine 


Purpose 


Called  by 


Calls 


MSMCON 


Main  program 
Sets  start  and  ending  times 
and  time  step  for  run. 


not 

applicable 


PPTCON 

HIEPAR 


PPTCON 


Executive  routine  to  control 
flow  of  MSM.  EandB 
field  models  are  computed  in 
EBCON;  particle  traces  are 
done  in  PPTM. 


MSMCON 


RDGRID 

OUTP 

FLXNIT 

DTIME 

EBCON 

EPREAD 

SETALM 

BNDSET 

RDHDR 

INITAL 

PPTM 

FLXDFL 

AURLl 

PWRCAL 

WRT3D 


FECON 

MLTSET 

SETSCT 

BTRACE 

EFBNDY 

EFIELD 

OUTP 

FNDBND 

G3NTRP 

VMLSET 

WRT3D 


EBCON 


Executive  routine  to  control 
calculation  of  electric  and 
magnetic  field  models. 


PPTCON 


HIEPAR 


Subroutine  to  give  energetic 

particle  results. _ 


MSMCON 


presently 
dummv 


Magnetic  Field  Routines 


Routine 


BTRACE 


FNDBRK 


GETMAT 


LOADBM 


MXINIT 


RMVBSH 


ZEROBM 


Purpose  _ 


Subroutine  to  calculate  B 
field  models  appropriate  for 
geophysical  conditions  as 
specified  by  FSTOFF, 
FEQEDG,  FDST,  FCLPSE, 
and  FTILT. 


Subroutine  to  rotate  fixed 
grid  B  field  arrays  to  match 
rotating  coordinate  system. 


Subroutine  to  find  the 
proper  B  field  array  indices 
that  bracket  the  magnetic 
field  input  parameters. 


Subroutine  to  find  the  B 
field  matrices  needed  for 
interpolation  in  order  to 
represent  current  conditions. 


Subroutine  to  load 
individual  B-matrices  from 
the  B-supermatrix  into  the 
work  B-matrices. 


Subroutine  to  initialize  the 
array  MEXIST  to  reflect  the 
B-matrices  that  exist  in  the 
B-super  matrix. 


Subroutine  to  extrapolate  B- 
field  matrices  "into  the 
bushes",  ie.,  into  extremely 
stretched  or  open  regions. 


Subroutine  to  zero  out  an 
individual  B  matrix  within 
the  working  B  matrices. 
This  is  done  when  an 
individual  matrix  needed  in 
the  interpolation  does  not 
exist  in  the  computed  B- 
supermatrix. 


Called  by 


EBCON 


BTRACE 


GETMAT 


GETMAT 


BTRACE 


GETMAT 


GETMAT 

RMVBSH 

BFGYRO 


MXINIT 

FNDBRK 

LOADBM 

ZEROBM 

OUTP 


Electric  Field  Routines 


Routine 

Purpose 

Calls 

EFIELD 

Subroutine  to  return  values 
of  the  potential  on  the 
northern  hemisphere  grid 
(VNORTH),  on  the 
southern  hemisphere  grid 
(VSOUTH),  and  the  average 
of  the  two  hemispheres  (V). 

EBCON 

EMODEL 

AURORA 

Returns  potential  at  a 
specific  location  in  auroral 
region. 

EMODEL 

none 

EFBNDY 

Subroutine  to  calculate 
latitudes  and  widths  of  efield 
bndys  2  and  3. 

EBCON 

EFLOC 

G3NTRP 

EFLOC 

Subroutine  to  find  grid 
location  (BI,B  J)  of  physical 
location  (RVALjXLT). 

EFBNDY 

PFIX 

EMODEL 

Returns  the  electric  potential 
arrays  VNORTH, 

VSOUTH.  and  Vat  all  grid 
pts. 

EFIELD 

INPUT 

THET 

EPOT 

LOW 

AURORA 

REGl 

EPOT 

Using  scaled  Heppner- 
Maynard  model  returns 
potential  at  a  specific  pt. 

none 

FNDBND 

Subroutine  to  compute  time 
dependent  outer  boundary 
location. 

EBCON 

THET 

INPUT 

Get  input  needed  for 
computation  of  Heppner- 
Maynard  model. 

EMODEL 

none 

LOW 

Returns  potential  at  a 
specific  location  in  low 
latitude  region. 

EMODEL 

none 

"REGI 

Returns  potential  at  a 
specific  location  in  region  1. 

EMODEL 

none 

THET 

Function  that  gives  eqn  for 
an  E  field  boundary  ellipse 
in  flat  polar  coordinates. 

Ml 

none 

Particle  Trace  Routines 


Routine 


PPTM 


BNDCHK 


BNDSET 


CFACT 


DVEFDI 


DVEFDJ 


FLXNIT 


FLXVAL 


Purpose 

Called  by 

Subroutine  to  trace  particle 
trajectories  from  each  grid  pt 
for  each  particle  species 
back  in  time  from 
time=TSTART  to 
time=TSTOP. 

PPTCON 

SETREF 

OUTP 

TNORML 

G3NTRP 

WKRATE 

MOVER 

MODFDC 

TCHK 

BNDCHK 

FLXVAL 

Subroutine  to  determine 
whether  particle  has  crossed 
bndy  of  calculation. 

PPTM 

TNORML 

Subroutine  to  compute 
boundary  plasma 
distribution. 

PPTCON 

none 

Function  subprogram  to 
compute  correction  factor 
based  on  equilibrium  eta 
values. 

not  called 

none 

Function  subprogram  to 
compute  the  I  derivative  of 
the  effective  potential  at  grid 
pt  (I,J)  at  normalized  time 
BT. 

VLOCTY 

none 

Function  subprogram  to 
compute  the  J  derivative  of 
the  effective  potential  at  grid 
pt  (I,J)  at  normalized  time 
BT. 

VLOCTY 

none 

Subroutine  to  compute  Kp- 
depcndent  flux  at 

L=3,4,6,6,  and  13  for 
electrons  of  given  energy  for 
a  given  Kp  condition. 

FLXNIT 

none 

Subroutine  to  calculat  Kp 
based  particle  number  flux 
in  units  of 

particles/cm**2/s/sr/eV  as 
function  of  r,  energy,  and 
Kp. 

PPTCON 

FLXCAL 

THRCAL 

Function  subprogram  to 
calculate  Kp-dependent  flux 
value  at  R=RR  for  particles 
of  energy  ENRG  and 
KP=PT&’  by  interpolating 
FLXMAT  array. 

PPTM 

BNDSET 

INTTAL 

SETREF 

FLXDFL 

G3NTRP 

Routine 


FLXTRP 


INITAL 


MOVER 


PWRCAL 


RLYONS 


SETALM 


SETREF 


TCHK 


THRCAL 


VLOCTY 


Purpose  _  _ 


Function  subprogram  to 
reium  LOG  10  of  empirical 
flux  value  interpolated 
between  values  at 
L=3,4,6.6,  and  13  Re. 


Subroutine  to  compute  initial 
plasma  distribution 


Subrouune  to  advance  one 
particle  location  one  time 
step  using  4th-order  Runge- 
Kutta  algorithm  with  5th 
order  correction. 


Subroutine  to  estimate 
precipitating  electron  energy 
flux  poleward  of  the  main 
MSM  modeling  region  by 
comparing  flux  within 
modeling  region  with  Hardy 
statistic^  values. 


4th  order  Runge-Kutta 
routine 


Function  subprogram  to 
evaluate  Lyons-based  weak 
loss  rate. 


Subroutine  to  read  the 
number  of  energy  channels 
and  their  energies  at 
geosynchronous  orbit  and 
calculate  the  energy  invariant 
species  needed  to  run  the 


reference  flux. 


Subroutine  to  set  species 
dependent  pitch  angle 
scattering  efficiency. 


PPTCON 


MOVER 


WKRATE 


PPTCON 


VLOCTY 


Subroutine  to  calculate 
threshold  flux  at  R=3, 4, 
6.6,  and  13  RE  for 
KP=FKP  and 
LOG(energy)=FNRGLG. 


Subroutine  to  compute  I  and 
J  components  of  particle 
velocity  with  energy 
invariant  AALAM  at  location 
(BBI,BBJ)  at  normalized 
time  BT. 


PPTM 

FLXVAL 

TNORML 

EBCON 

none 

PPTM 

G3NTRP 

FLXNIT 

none 

RK4 

G3NTRP  I 

Input  and  Output  Data  Handling 


Routine 


FECON 


PARGEN 


DTNTRP 


DTXIPT 


INDATA 


OUTPUT 


Purpose 


Subroutine  to  obtain  time- 
normalized  observational 
values. 


Subroutine  to  obtain  va’ues 
from  the  environmental  data 
base  and  inteipolate  or 
extrapolate  as  appropriate  to 
provide  data  at  a  normalized 
time. 


Subroutine  to  return 
interpolation  values  for  the 
N  data  pairs  of 
(XA(I).YAa)).  where 
1=1, NA. 


Subroutine  to  return 
interpolation  values  for 
XIPATT. 


Subroutine  to  read  in  data 
for  the  MSM  during 
development  and  testing. 
This  routine  will  be  replaced 
in  the  operational  MSM  with 
an  interface  routine  to  the 
AWS  environmental 
database. 


Subroutine  to  output  MSM 
results  to  data  base. 


Subroutine  to  check  and 
extract  data  from  DARRAY 
into  XA  and  YA. 


Subroutine  to  calculate  the 
stand-off  distance  accordint 
to  a  formula  from  Alpbach 
(1979). 


EBCON 


FECON 


PARGEN 


PARGEN 


Calls 


PARGEN 


EvlDATA 

DFLTVL 

SMOOTH 

DTXIPT 

DTNTRP 

TTMINC 


presently  a 

dummy 

routine. 


TCONV2 


Default  and  Front-End  Models 


Routine 

Purpose 

Ii/  Mf  P  B 

Calls 

ADDHDY 

Subroutine  to  calculate  the 
Hardy  model  electron  flux 
value  for  a  given  point. 

AURLl 

AURLl 

Subroutine  to  determine 
default  Hardy  precipitating 
electron  flux. 

FNDHDY 

ADDHDY 

AURL2S 

Subroutine  to  calculate  the 
default  Hardy  precipitating 
ion  model. 

REGEN 

EFUN 

CLPDFL 

Subroutine  to  determine 
whether  or  not  to  use  the 
collapsed  tail  version  of  the 
magnetic  field  model. 

FECON 

none 

DSTDFL 

Subroutine  to  calculate 
default  (Kp  driven)  Dst 
value. 

FECON 

none 

EFUN 

Function  subprogram  used 
in  evaluation  of 
precipitating  ion  flux. 

AURLS2 

none 

EQTDFL 

Subroutine  to  calculate 
default  (Kp  driven) 
equatorward  edge  of  auroral 
zone  value. 

FECON 

none 

FLXDFL 

Subroutine  to  calculate  the 
energy-dependent  ETA  array 
ft-om  Kp  and  the  location  of 
the  grid  pts  by  interpolating 
the  empirical  FLXMAT 
array.  This  routine  is  used 
as  the  MSM  default  model 
when  full  particle  traces  are 
not  done. 

PPTCON 

FLXVAL 

FNDHDY 

Subroutine  to  find  and  read 
tire  pertinent  Fourier 
coefficients  for  the  Hardy 
electron  model. 

AURLl 

none 

FSUM 

Function  subprogram  that 
determines  the  sum  of  a 
Fourier  series  for  Hardy 
model. 

ADDHDY 

none 

PATDFL 

Subroutine  to  return  polar- 
cap  convection  pattern  type 
on  the  basis  of 
measurements  of  IMF  By 
and  Bz  components  if  direct 
measurements  of  pattern 
type  from  DMSP  are  not 
available. 

FECON 

none 

WEIS33MM 


REGEN 


STNDFL 


TILT 


Purpose 


Subroutine  to  calculate 
default  (Kp  driven)  cross- 
polar-cap  potential  value. 


Subroutine  used  in 
evaluation  of  Hardy  model 
precipitating  ion  flux. 


Subroutine  to  calculate  the 
standoff  distance.  If  solar 
wind  velocity  and  density 
data  are  available,  then 
Subroutine  STNDOF  does 
the  actual  calculation; 
otherwise,  the  default  is  Kp- 
based. 


Subroutine  to  calculate  the 
Earth's  tilt  angle.  Tilt 
presently  defaults  to  0. 


FECON 


STNDOF 


Utility  Routines 


Routine 

Purpose 

BLOCK 

DATA 

Sets  index  of  data  elements 
in  the  PARRAY  and 
AUGPAR  arrays.  Sets  I,J, 
and  ener]^  indices  for 
locations  and  species  to  be 
traced. 

Not 

applicable 

Not 

applicable 

G3NTRP 

Utility  function  subprogram 
to  perform  a  general  3-d 
linear  interpolation  of  an 
arbitrary  array  A(I,J,K)  at  pt 
(BI.BJ.BK). 

EBCON 

PPTM 

TCHK 

VLOCIY 

EFBNDY 

FLXVAL 

PWRCAL 

none 

G3TRPA 

Utility  function  subprogram 
to  perform  a  general  3-d 
linear  interpolation  of  an 
angular  array. 

PPTM 

none 

MLTSET 

Subroutine  to  calculate  time 
dependent  ALOCT  of 
rotating  grid  pts. 

EBCON 

none 

MODFDC 

Subroutine  to  adjust  BBJ  to 
be  between  2  and  JDIM-1. 

PPTM 

VLOCIY 

none 

OUTP 

Utility  subroutine  to  print 
out  array  information. 

Utility 

routine 

none 

PFIX 

Subroutine  to  adjust 
modulus  of  periodic  J 
coordinate. 

EFLOC 

none 

RDGRID 

Subroutine  to  read  grid 
system  coordinates  and 
calculate  essential  grid 
quantities. 

PPTCON 

none 

RDHDR 

Subroutine  to  read  the 
header  record  of  the 
standard  MSM  disk  file 
format. 

PPTCON 

none 

READ3D 

Subroutine  to  read  a  record 
from  the  standard  MSM  disk 
file  format 

PPTCON 

none 

TCONV2 

Function  to  take  a  start  year, 
start  decimal  day,  and 
current  decimal  day  to 
produce  a  value  that  is  the 
number  of  seconds  from 
midnight  of  the  start  year 
and  day. 

SMOOTH 

none 

Routine 

Purpose 

TC0NV3 

Function  to  take  a  start  year, 
start  day,  current  year, 
current  day,  and  current 
seconds  of  day  to  produce  a 
value  that  is  the  number  of 
seconds  from  midnight  of 
the  start  year  and  day. 

PARGEN 

none 

TIMING 

Subroutine  to  increment  time 
for  next  E  and  B  field 
record. 

EBCON 

PARGEN 

FECON 

none 

TNORML 

Utility  function  subprogram 
to  calculate  run-normalized 
time. 

PPTM 

BNDCHK 

RK4 

FNDLOC 

SETREF 

none 

WRT3D 

Subroutine  to  write  3-d 
arrays  into  the  standard 

MSM  disk  file  format. 

PPTCON 

EBCON 

none 
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2.5  System  Performance.  Some  factors  on  which  the  system  performance  depends  include: 

1.  Higher  energy  particles  require  more  time  to  process.  The  particles  move  so  rapidly  that  a 
smaller  time  step  is  required  to  move  their  position  and  the  number  of  time  steps  required  to  move 
the  particles  on  the  grid  is  correspondingly  higher. 

2.  The  output  files  are  updated  every  program  time  step.  If  the  program  is  set  to  run  for 
many  time  steps,  the  storage  of  these  files  could  be  a  problem.  The  maximum  number  of  time 
steps  is  set  within  the  program  to  50. 

3.  The  maximum  number  of  energy  channels  which  can  be  run  is  set  within  the  program  to 
30.  The  greater  the  number  of  channels  selected,  the  longer  the  run  time  will  be. 


2.7  Database^ata  Bank.  During  development  the  method  of  input  and  output  is  through  disk  files. 
These  files  will  no  longer  be  necessary  when  the  Environmental  Data  Base  interface  is  in  place. 
Attached  is  a  list  of  the  input  parameters  and  units.  Also  attached  is  the  proposed  data  transfer 
method. 


2.8  General  Description  of  Inputs.  Processing.  Outputs. 


a.  Inputs  - 

The  following  parameters  are  set  within  the  program: 

IINC(l)  Program  time  step  increment  (year) 
IINC(2)  Program  time  step  increment  (day) 

IINC(3)  Program  time  increment  (seconds) 


Following  are  the  input  files  required,  including  those  to  be  replaced  eventually  by  calls  to  the 
environmental  data  base: 

*  denotes  the  principal  operator  interfaces  to  the  program 
BOxxxxxx  The  magnetic  field  matrices  needed  for  the  model  run. 
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CLAPSE 

CCX)RD 

DKTABLE 

DST 

EFCOEF 

ENCHAN* 

EQEDGE 

FKP 

HARDY 

lONENG 

lONNUM 

MSMIN* 

PCP 

SWDEN 

SWVEL 

XIPATT 


File  containing  values  giving  the  collapse/no  collapse  state  of  the 
magnetosphere.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete. 

File  of  values  to  set  up  the  coordinate  system. 

Loss  lifetimes  for  computing  ion  loss  by  charge  exchange. 

Dst  values  for  the  event.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete. 

Coefficients  from  Heppner-Maynard  model  which  are  input  to  the  electric  field 
model. 

Input  values  for  the  number  of  energy  channels,  particle  type  and  energy 
channels  for  the  model  to  simulate. 

Values  of  the  equatorward  edge  of  the  auroral  oval  at  midnight  used  as  input 
into  the  electric  field  model.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete. 

Kp  data  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data  base, 
when  complete. 

Coefficients  used  by  the  Hardy  precipitating  electron  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

Coefficients  used  as  input  fw  the  ion  precipitating  model. 

Specify  start  and  stop  times,  a  character  list  identifier,  and  sunspot  number 

Cross-polar  cap  potential  values  for  event  used  as  input  to  the  electric  field 
model.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete. 

Solar  wind  density  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete. 

Solar  wind  velocity  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete. 

Polar  cap  pattern  type  used  as  input  to  electric  field  model  for  the  event.  To  be 
replaced  by  call  to  AWS  environmental  data  base,  when  complete. 
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b.  Processing  -  After  the  data  is  gathered  from  the  input  files,  it  goes  through  Subroutine 
PARGEN  which  interpolates  or  extratpolates  data  as  appropriate  to  provide  data  a  a  normalized 
run-time.  Subroutine  FECON  then  calculates  the  physical  parameters  needed  by  the  model  for 
each  run  time  label.  When  the  Environmental  Database  interface  is  operational,  output  from  the 
model  will  then  return  to  the  Environmental  Data  Base  through  Subroutine  OUTTITT.  (At  present 
OUTPUT)  is  only  a  place-holding  stub.)  The  MSM  Control  and  Data  Flow  Diagram  is  attached. 


c.  Outputs.  The  following  files  are  output: 


V 

VNORTH 

VSOUTH 

VM 

BMIN 

XMIN 

YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 


EAVG 

AUGPAR 

COLAT 

ALOCT 

FLUX 


Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts).  Output  for  each  time  label. 

Northern  hemisphere  electric  potential  distribution  (Volts).  Output  for  each  time 
label. 

Southern  hemisphere  electric  potential  distribution  (Volts).  Output  for  each  time 
label 

Flux  tube  volume  ((Re/nT)'2/3).  Output  for  each  time  label 

Equatorial  magnetic  field  strengA  (nT),  Output  for  each  time  label 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  Ae  equatorial 

(B-field  minimum)  plane  (Re).  Output  for  each  time  label 

GSM  Y  location  of  where  field  Ime  goAg  through  grid  pt  crosses  the  equatorial 

(B-field  minimum)  plane  (Re).  Output  for  each  time  label 

GSM  Z  location  of  where  field  Ime  going  Arough  grid  pt  crosses  Ae  equatorial 

(B-field  minimum)  plane  (Re).  Output  for  each  time  label 

Location  of  outer  boundary  of  detailed  particle  traces.  Output  for  each  time 

label 

Precipitation  energy  flux  array  (ergs/cm^-sec).  Output  for  each  time  label 
Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  H'*'  and  (3)  O'*")  (ergs/cmLsec).  Output  for  each  time  label 
Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H+  and  (3)  0‘'’(eV). 
Output  for  each  time  label 

Augmented  data  array  for  mput  values.  Output  for  each  time  label 

Grid  colatitude  array  (raAans).  Output  for  each  time  label 

Grid  local  time  array  (raAans  eastward  from  noon).  Output  for  each  time  label 

Flux  values  for  all  energy  channels  at  all  grid  points.  Output  for  each  time  label 

for  each  energy  channel 


3.2  Input  Requirements. 

Start  and  stop  times  are  specified  to  Ae  program  through  the  5  line  MSMIN  file  as  year  (eg., 
1988),  day  (eg.,  1 12  for  the  1 12  A  day  of  the  year),  and  time  in  seconds  from  the  beginning  of 
Ae  start  day  (eg.,  43200  for  noon).  For  example,  the  following  configuration  of  the  MSMIN  file 
will  run  Ae 


USERS  MANUAL  -  4 


MSM  from  1800  on  the  1 12th  day  of  1988  through  1830  on  the  same  day.  This  is  a  fresh  startup 
of  the  program  (direct  access  record  number  is  zero)  and  the  sunspot  number  is  0.0. 


1988  112  64800 
1988  112  66600 
0 

'30  minute  test  run' 
0.0 


'start  year,  start  day,  stan  time  in  seconds' 
'end  year,  end  day,  end  time  in  seconds' 

'  0  signifying  new  start' 

'up  to  80  character  run  identification' 

'  sunspot  number' 


The  time  step  increment  is  set  in  the  program  through  the  IINC  vector. 

IINC(l)  =  Increment  Year 
IINC(2)  =  Increment  Day 
IINC(3)  =  Increment  Time  (seconds) 

If  the  run  is  to  be  a  restarted  using  previous  data,  the  direct  access  record  number  for  restarting  is 
also  read  from  the  MSMIN  file.  For  example,  the  program  is  currently  set  up  to  run  year  1988, 
day  1 12,  hour  18  (64800  seconds)  through  year  1988,  day  1 12,  hour  1830  (66000  seconds)  in  15 
minute  (900  second)  increments.  Since  it  is  a  new  run  the  start  record  number  is  set  to  zero  in 
MSMIN. 

If  after  running  this  interval  you  want  to  restart  the  model  at  hour  1830  and  continue  through  hour 
20,  the  MSMifj  input  file  would  be: 

1988  112  66600 
1988  112  72000 
3 

'MSM  run  restart  from  1830  on  day  112' 

0.0 


The  model  would  go  back,  pick  up  the  original  5  records  and  continue  the  run  from  hour  19  to 
hour  20. 


Input  file  ENCHAN  controls  how  many  and  which  energy  channels  are  calculated.  The  file  set  up 
is: 


Number  of  energy  channels  to  be  modeled  (maximum  30,integer) 
Particle  type  1  (integer).  Energy  1  (floating  point) 

Particle  type  2  (integer).  Energy  2  (floating  point) 

Particle  type  n  (integer).  Energy  n  (floating  point) 


The  acceptable  particle  type  input  is: 
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1  electrons 

2  H+ 

3  O 

The  energy  is  at  geosynchronous  orbit  in  keV.  The  energies  must  be  in  ascending  order,  with 
particle  types  grouped  together,  which  are  checked  within  the  program. 

For  example, 

4 

140 

1  55 

2  10 
2  15 

This  is  to  model  4  energy  channels,  the  first  two  are  elections  of  40  and  55  keV  at  geosynchronous 
orbit.  The  second  two  are  ions  of  10  and  15  keV  energy  at  geosynchronous  orbit. 


3.3  Output  Requirements.  The  following  files  are  output.  When  the  Environmental  Data  Base  is 
complete,  these  files  will  be  stored  there.  The  file  of  immediate  use  to  forecasters  is  the  FLUX 
data  file  which  contains  the  particle  flux  information  for  the  desired  energy  channels  at  all  points  on 
the  model  grid.  The  other  data  files  will  be  needed  for  post-analysis  of  die  event. 


V 

VNORTH 

VSOUTH 

VM 

BMIN 

XMIN 

YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 

EAVG 


Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts).  Output  for  each  time  label. 

Northern  hemisphere  electric  potential  distribution  (Volts).  Output  for  each  time 
label. 

Southern  hemisphere  electric  potential  distribution  (Volts).  Output  for  each  time 
label 

Flux  tube  volume  ((Re/nT)-2/3).  Output  for  each  time  label 

Equatorial  magnetic  field  strength  (nT),  Output  for  each  time  label 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 

(B-field  minimum)  plane  (Re).  Output  for  each  time  label 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 

(B-field  minimum)  plane  (Re).  Output  for  each  time  label 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 

(B-field  minimum)  plane  (Re).  Output  for  each  time  label 

Location  of  outer  boundary  of  detailed  particle  traces.  Output  for  each  time 

label 

Precipitation  energy  flux  array  (ergs/cm^-sec).  Output  for  each  time  label 
Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  H"*"  and  (3)  O'*")  (ergs/cm^-sec).  Output  for  each  time  label 
Average  precipitating  electron  energy  for  (1)  electtons,  (2)  H+  and  (3)  0‘'‘(eV). 
Output  for  each  time  label 
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AUGPAR 

COLAT 

ALOCr 

FLUX 


Augmented  data  array  for  input  values.  Output  for  each  time  label 

Grid  colatitude  array  (radians).  Output  for  each  time  label 

Grid  local  time  array  (radians  eastward  from  noon).  Output  for  each  time  label 

Flux  values  for  all  energy  channels  at  all  grid  points.  Output  for  each  time  label 

for  each  energy  channel 


PARAMETER  I  NAME  I  UNITS  ]V0\  TimeTag  |  Cco.  Latiiude  j  Cco.  Longitude  I  AUitude 


END  USERS  MANUAL 
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End  Users  Manual 


2.1.2  Performance.  Some  factors  on  which  the  system  performance  depends  include: 

1.  ffigher  energy  particles  require  more  time  to  process.  The  particles  move  so  rapidly  that 
smaller  time  step  is  required  to  move  their  position  and  the  number  of  lime  steps  required  to  move 
the  particles  on  the  grid  is  correspondingly  higher. 

2.  The  output  files  are  updated  every  program  time  step.  If  the  program  is  set  to  run  for 
many  time  steps,  the  storage  of  these  files  could  be  a  problem.  The  maximum  number  of  time 
steps  is  set  within  the  program  to  50. 

3.  The  maximum  number  of  energy  channels  which  can  be  mn  is  set  within  the  program  to 
30.  The  greater  the  number  of  channels  selected,  the  longer  the  run  time  will  be. 
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Computer  Operation  Manual 


2.1  System  Application.  The  Magnetospheric  Specification  Model  was  developed  as  a  set  of 
algorithms  to  be  developed  into  a  r^-time  program  for  use  in  the  Space  Forecast  Center  operated 
by  the  Air  Weather  Service  of  the  U.S.  Air  Force.  It  is  intended  to  help  the  Center  personnel 
perform  their  mission  of  providing  information,  particularly  during  magnetospheric  disturbances, 
to  "customers"  who  operate  spacecraft.  The  output  of  the  model  includes  (but  is  not  limited  to); 

1)  Fluxes  of  electrons  and  ions  in  the  inner  plasma  sheet  and  the  geosynchronous  orbit 
region. 

2)  Energy  fluxes  and  characteristic  energies  of  electrons  precipitated  into  the  auroral 
ionosphere. 


2.4  Information  Inventory. 


2.4.1  Resource  Inventory. 

Following  are  the  files  accessed  by  the  MSM,  including  those  to  be  eventually  replaced  by  calls  to 
the  environmental  data  base.  Those  required  for  a  restart  are  so  labelled. 

Input  data  sets 


*  denotes  principal  mode  of  operator  control  of  program 


BOxxxxxx 

CLAPSE 


COORD 

DKTABLE 

DST 

EFCOEF 

ENCHAN* 

EQEDGE 

FKP 

HARDY 

lONENG 


The  magnetic  field  matrices  needed  for  the  model  run.  Required  for  restart. 
File  containing  values  giving  the  coUapse/no  collapse  state  of  the 
magnetosphere.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete. 

File  of  values  to  set  up  the  coordinate  system.  Required  for  restart. 

File  of  decay  times  for  computing  ion  loss  by  charge  exchange. 

Dst  values  for  the  event.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (nT). 

Cloefficients  from  Heppncr-Maynard  model  which  are  input  to  the  electric  field 
model.  Required  for  restart. 

Input  values  for  the  number  of  energy  channels,  type  and  energy  of  particles  to 
be  traced.  Required  for  restart. 

Values  of  the  equatorward  edge  of  the  auroral  oval  at  midnight  used  as  input 
into  the  electric  field  model.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (degrees). 

Kp  data  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data  base, 
when  complete.  Required  for  restart. 

Coefficients  used  by  the  Hardy  precipitating  electron  model.  Required  for 
restart 

Coefficients  used  as  input  for  the  ion  precipitating  model.  Required  for  restan. 
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lONNUM 

MSMIN* 

PCP 

SWDEN 

SWVEL 

XIPATT 

Output  data  sets 
V 

VNORTH 

VSOUTH 

VM 

BMIN 

XMIN 

YMIN 


Coefficients  used  as  input  for  the  ion  precipitating  model.  Required  for  restart. 
Primary  input  file  to  control  run.  Provides  start  and  end  times  for  run,  a 
character  string  identifier  for  run,  and  sun  spot  number.  Required  for  restan. 
Cross-polar  cap  potential  values  for  event  used  as  input  to  the  electric  field 
model.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete  (kV). 

Solar  wind  density  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(particles/cm^) 

Solar  wind  velocity  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(km/sec) 

Polar  cap  pattern  type  used  as  input  to  electric  field  model  for  the  event.  To  be 
replaced  by  call  to  AWS  environmental  data  base,  when  complete. 


Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Northern  hemisphere  electric  potential  distribution  (Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Southern  hemisphere  electric  potential  distribution  (Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Flux  tube  volume  ((Re/nT)-2/3). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Equatorial  magnetic  field  strength  (nT). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 
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ZMIN 

BNDLOC 

EFLUX 

FLXSUM 

EAVG 

AUGPAR 

COLAT 

ALOCT 

FLUX 


Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Location  of  outer  boundary  of  detailed  particle  traces. 

Output  volume  -  number  of  longitudinal  gridpoints  x  number  of  time  steps  x  4 
(bytes) 

Pi^pitating  energy  flux  array  (ergs/cm^-sec). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 
Totd  precipitation  energy  flux  array  (integrated  over  species  fo^  (1)  electrons 
(2)  and  (3)  O"^)  (ergs/cm^-sec). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H'*'  and  (3)  0"''(eV). 
Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Augmented  data  array  for  input  values. 

Output  volume  -number  of  data  elements  x  number  of  time  steps  x  4  (bytes) 
Grid  colatitude  array  (radians). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Grid  local  time  array  (radians  eastward  from  noon). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Flux  values  for  all  energy  channels  at  all  grid  points.  Needed  for  restart. 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 


2  Report  Inventory 


2.4. 


;.  A  print  file  of  arrays  of  different  parameters  is  currently  generated. 


TEST  PLAN 
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Test  Plan 


2.  DEVELOPMENT  ACnvrrY 


2.1  Statement  of  Pretest  Activity.  During  the  development  phase  the  model  output  was  compared 
to  observed  data  for  2  events  -  CDAW6  March  22, 1978  interval  and  April  22-24, 1988  interval. 


2.2  Pretest  Activity  Results.  Results  of  the  CDAW6  interval  are  discussed  in  "Chapter  IV  - 
Testing  the  Model  Using  the  CDAW6  Event"  of  B.  Hausman's  Masters  Thesis  (included  as  an 
appendix  to  this  test  plan.)  MSM  results  are  compared  quandtadvely  with  observadons  for  the 
April  32-34, 1988  period  in  the  Rice  MSM  final  report, 
i  3 


3.1  System  Descriprion. 

Start  and  stop  dmes  and  start  direct-access  record  number  are  provided  in  input  file  MSMIN. 

Following  are  the  input  files  required,  including  those  to  be  replace  by  calls  to  the  environmental 
database; 


BOxxxxxx 

CLAPSE 


COORD 

DKTABLE 

DST 

EFCOEF 

ENCHAN 

EQEDGE 


FKP 

HARDY 

lONENG 

lONNUM 


The  magnedc  field  matrices  needed  for  the  model  run. 

File  containing  values  giving  the  coUapse/no  collapse  state  of  the 
magnetosphere.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete. 

File  of  values  to  set  up  the  coordinate  system. 

Decay  dmes  for  computing  charg-exchange  loss  of  ions 

Dst  values  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data 

base,  when  complete  (nT). 

Coefficients  from  Heppner-Maynard  model  which  are  input  to  the  electric  field 
model. 

Input  values  for  the  number  of  energy  channels,  particle 
type  and  energy  channels  for  the  m^el  to  simulate. 

Values  of  the  equatorward  edge  of  the  auroral  oval  at  midnight  used  as  input 
into  the  electric  field  model.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (degrees). 

Kp  data  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data  base, 
when  complete. 

Coefficients  used  by  the  Hardy  precipitating  electron  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 
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PCP 

SWDEN 

SWVEL 

XIPATT 


Cross-polar  cap  potential  values  for  event  used  as  input  to  the  electric  field 
model.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete  (kV). 

Solar  wind  density  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(particles/cm^) 

Solar  wind  velocity  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(km/sec) 

Polar  cap  pattern  type  used  as  input  to  electric  field  model  for  the  event.  To  be 
replaced  by  call  to  AWS  environmental  data  base,  when  complete. 


Following  are  the  output  files: 


V 

VNORTH 

VSOUTH 

VM 

BMIN 

XMIN 

YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 


EAVG 

AUGPAR 

COLAT 

ALOCT 

FLUX 


Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts). 

Northern  hemisphere  electric  potential  distribution  (Volts). 

Southern  hemisphere  electric  potential  distribution  (Volts). 

Flux  tube  volume  ((Re/nT)-2A). 

Equatorial  magnetic  field  strength  (nT). 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Location  of  outer  boundary  of  detailed  particle  traces. 

Precipitating  energy  flux  array  (ergs/cm^-sec). 

Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  H+  and  (3)  O'*")  (ergs/cm^-secX 

Average  precipitating  electron  ci.^rgy  for  (1)  electrons,  (2)  H"*"  and  (3)  0+(eV). 
Augmented  data  array  for  input  values. 

Grid  colatitude  array  (radians). 

Grid  local  time  array  (radians  eastward  from  noon). 

Flux  values  for  all  energy  channels  at  all  grid  points 


4.  TEST  SPECmCATION  AND  EVALUATION 


4. 1  Test  Spedfication.  The  set  of  algorithms  encoded  as  the  MSM  have  been  run  and  tested  at 
Rice  University.  The  results  have  been  studied  by  comparing  the  model  results  with  observed 
data.  The  version  of  the  program  code  which  was  developed  at  Rice  University  gives  the  verified 
results.  To  validate  the  algorithms  delivered  to  the  Space  Forecast  Center,  the  output  from  the  code 
run  at  Rice  University  will  be  compared  with  that  run  at  the  Space  Forecast  Center. 
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4.2  Test  Methods  and  Constraints. 

4.2.1  Test  Condirions.  The  input  data  will  come  from  Rice  University. 


4.4  IsstEvalBariQp- 

4.4. 1  Test  Data  Criteria.  Using  the  output  data  furnished  from  Rice  University,  the  output  from 
the  code  run  at  the  Space  Forecast  Center  should  be  the  same. 
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IV.  TESTING  THE  MODEL  USING  THE  CDAW6  EVENT 


A.  General  Description  of  Event 

The  Coordinated  Data  Analysis  Woricshop  #6  (CDAW6)  focused  its  effort  on 
understanding  the  physical  processes  which  control  the  flow  of  energy  from  the  solar 
wind  through  the  magnetosphere  and  the  eventual  release  through  magnetospheric 
substorms.  The  participants  studied  the  first  of  2  large  substorms  which  occurred  on 
March  22, 1979.  Preceded  by  a  day  of  quiet  conditions  both  in  the  solar  wind  and  the 
magnetosphere,  a  storm  sudden  commencement  was  observed  at  0826UT  followed  by 
the  onset  of  the  expansive  phase  of  the  first  substorm  at  1054UT.  The  ready  availability 
of  a  large  data  set  and  numerous  papers  (see  Journal  of  Geophysical  Research  volume 
90,  February  1985  for  most  of  them)  made  it  a  natural  candidate  for  the  preliminary 
testing  of  the  model's  capabilities. 

Figure  4, 1  is  a  summary  of  solar  wind  plasma  parameters  at  IMP-8  Oocated  slightly 
to  the  duskside  of  the  bow  shock)  and  the  AE  magnetic  activity  index  published  as  Figure 
2  in  the  overview  paper  by  McPherron  and  Manka  (1985).  The  major  features  of  these 
data  include: 

1)  An  interplanetary  shock  arrives  at  IMP-8  at  0821:20UT,  as  indicated  by  an 
increase  in  solar  wind  density,  velocity  and  magnetic  field  strength. 

2)  At  0826UT  the  shock  arrives  at  the  dayside  of  the  earth  compressing  the 
magnetosphere  causing  a  sudden  storm  commencement,  which  can  be  seen  as  a  small 
spike  in  the  AE  index. 

3)  The  magnetic  field  turns  southward  at  IMP-8  at  1008UT  which  begins  the 
stretching  of  the  magnetotail  and  the  growth  phase  of  the  first  substorm. 

4)  The  first  substorm  expansion  onset  at  1054UT  produced  auroral  zone  magnetic 
activity  (as  measured  by  the  AE  index)  exceeding  1(X)0  nT. 


Universal  Time 


Figure  4.1  Summary  of  solar  wind  plasma  parameters  at  IMP  8  on  March  22,1979.  Top 
traces  show  5-min  averages  of  solar  wind  velocity  and  density.  Middle  trace  shows 
1-min  values  of  the  GSM  Z  component  of  the  IMP  at  IMP  8.  Bottom  trace  presents  a 
55- station  AE  index  calculated  at  1  min  time  resolution. 
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5)  At  1 122UT  the  IMF  becomes  northward  at  IMP-8,  magnetic  activity  starts  to 
decline  and  the  recovery  phase  of  the  substorm  begins. 

B.  Model  Inputs 
1.  Magnetic  Field  Model 

After  studying  the  IMF  data  and  Dst  index,  Dr.  G.-H.  Voigt  subdivided  the 
CDAW-6  interval  into  17  time  labels  (Table  4.1)  which  represent  different  configurations 
of  the  magnetic  field  during  the  event  The  magnetic  field  matrices  were  then 
pre-computed  for  each  time.  The  inputs  to  the  model  are 

STAND  -  the  magnetopause  standoff  distance  (Re)  from  the  solar  wind  data. 

Dst  -  the  standard  index  of  ring  current  intensity  (nT). 

Aur.Eq.Bd.  -  the  equatorward  edge  of  the  auroral  zone  at  midnight  (information  on 
how  this  is  done  is  in  Section  2  -  Electric  Field  Model  Inputs). 

Map(E)  -  the  expected  mapping  from  the  Aur.Eq.Bd.  (above)  to  the  inner  edge  of 
the  plasma  sheet  at  local  midnight  in  the  equatorial  plane  of  the  magnetosphere  (Re).  This 
was  estimated  using  the  work  by  Kivelson  et  al.(1979),  Horowitz  et  al.  (1986),  and 
Gussenhoven  et  al.  (1981)  who  have  calculated  Kp-based  relationships  between  the 
inner  edge  of  the  plasma  sheet  and  the  equatorward  edge  of  the  auroral  zone. 

From  these  four  observable  parameters,  Hilmer  (1989)  has  devised  a  scheme  to 
estimate  the  remaining  input  values  necessary  to  run  the  model: 

TILT  -  Dipole  tilt  angle  (set  to  0.0  for  the  CDAW-6  event). 

HJNEAR  -  Strength  of  the  cross-tail  current  sheet  at  the  inner  edge. 

XNEAR  -  Location  of  the  inner  edge  of  the  model  plasma  sheet  at  local  midnight 
(Re). 

HJFRAC  -  Fraction  of  HJNEAR  appearing  at  and  beyond  (XNEAR- 100)  Re. 
Current  intensity  is  constant  in  the  far  tail. 
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LABEL  =  1 

6:00 

UT 

Pre-Storm  Sudden  Commencement 

LABEL  =  2 

8:26 

UT 

Storm  Sudden  Commencement 

LABEL  =  3 

10:00 

UT 

Same  as  LABEL  2  but  little  bit  more  stretch 

LABEL  =  4 

10:20 

UT 

IMF  turns  southward 

LABEL =5 

10:54 

-EPS 

Maximum  stretch  just  before  onset  of  first  substorm 

LABEL =6 

10:54 

+  EPS 

Collapse  right  after  onset  of  substorm 

LABEL =7 

11:30 

UT 

End  of  phase  "gradually  back  to  normal" 

LABEL =8 

12:06 

UT 

Nominal  phase  (i.e.  nominal  model) 

LABEL =9 

12:43 

UT 

Nominal  phase 

LABEL  =  10 

13:10 

UT 

IMF  turns  southward 

LABEL  =  11 

13:40 

UT 

Gradual  stretching  period 

LABEL =  12 

14:07 

UT 

Gradual  stretching  period 

LABEL  =  13 

14:36 

-EPS 

Maximum  stretch  just  before  onset  of  second  substorm 

LABEL  =  14 

14:36  +  EPS 

Collapse  right  after  onset  of  substorm 

LABEL  =  15 

15:15 

UT 

Gradually  back  to  normal  after  collapse 

LABEL  =  16 

15:50 

UT 

Gradually  back  to  normal 

LABEL  =  17 

16:00 

UT 

Beginning  of  last  nominal  phase 

Table  4. 1  Critical  time  labels  for  CD AW-6  event. 
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DY  -  Scale  length  for  changes  in  tail  structure  along  the  GSM  y-axis  (Re).  This 
appUes  to  the  westward  tail  current  system. 

DFIL  -  Plasma  sheet  thickness  parameter. 

BRN,  BRP  -  Ring-current  contributions  (nT)  at  Earth's  center  from  the  westward 
and  eastward  components,  respectively  (BRN  <  0,  BRP  >  0). 

RN,  RP  -  Characteristic  radii  of  the  westward  and  eastward  ring-current 
components,  respectively. 

COLLAP  -  Fraction  of  the  prc-coUapse  midnight  cross-tail  current  remaining  in  the 
disturbed  region  (from  the  inner  edge,  XNEAR  to  XNEAR  -  DELXC).  COLLAP  =1.0 
means  no  collapse. 

DELXC  -  The  distance  from  the  inner  edge  (Re),  along  the  x-axis,  which  is  altered 
by  the  addition  of  eastward  tail  current.  DELXC  =  0.0  means  no  collapse. 

DYC  -  Scale  length  for  changes  in  tail  structure  along  the  GSM  y-axis  (Re).  Applies 
to  the  eastward  disruption  collapse  current.  DYC  is  always  less  than  DY.  DYC  =  0.0 
means  no  collapse. 

Table  4.2  from  Dr.  R.  Hilmer  contains  a  list  of  these  parameters  for  the  CDAW-6 
event  Also  listed  are  three  output  parameters: 

MAP(R)  -  The  resulting  midnight  equatorial  mapping  distance  (Re). 

RC  Zero  -  Characteristic  radius  for  the  ring  current  (Re).  The  ring  current  changes 
sign  at  this  distance  and  is  an  implied  particle  pressure  maximum. 

Min-Loc  -  The  minimum  IB  I  and  its  location  in  the  equatorial  plane  at  midnight 
2.  Electric  Field  Model 

The  cross  polar  cap  potential  was  calculated  from  the  IMF  data  and  the  empirical 
formula  suggested  by  Crooker  et  al.  (1982)  and  presented  by  Reiff  and  Luhmann  (1986) 
(|)(kV)  =  22  +  0.069  vB  Q1 

where  Q1  =  a(a  -  cos  0)  (a^  +  1  -  2a  cos  0)-^/2  for  cos  0  <  a 


Table  4.2  Input  parameters  for  B-field  model  for  CDAW-6  interval. 
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Q1=0 


for  cos  9  >  a 


a  =  min 


60  nT 


0  =  polar  angle  of  the  IMF 

Bt  =  projection  of  IMF  on  solar-magnetosphere  y-z  plane 
Bg  =  magnetic  field  just  inside  magnetopause 
The  polar  cap  pattern  type  was  also  estimated  from  By  and  Bz  IMF  data  for  each  time 
label  using  the  criteria  given  in  chapter  3.  For  the  CDAW-6  interval,  the  equatorward 
edge  of  the  diffuse  aurora  was  based  on  electron  data  from  DMSP,  P78,  and  TIROS 
satellites. 

Table  4.3  contains  the  input  data  calculated  by  Dr.  R.  A.  Wolf  and  used  during  the 
interval  for: 

VP  VC  -  cross-polar  cap  potential  (kV). 

IPATTV  -  polar  cap  pattern  type. 

EDGE  -  equatorward  edge  of  auroral  zone  at  midnight. 

A(L)  -  radius  of  ellipse  measured  in  x  (sunward)  direction. 

B(L)  -  radius  of  ellipse  measured  in  y  (duskward)  direction. 

DX(L)  -  sunward  displacement  of  coordinate  system  center  from  pole. 

DY(L)  -  duskward  displacement  of  coordinate  system  center  from  pole. 

3.  Boundary  Plasma  Condition 

The  invariant  temperatures  were  estimated  from  data  from  the  ISEE-2 

satellite,  as  shown  in  Figure  4.2  and  published  as  Figure  1  in  Paschmann  et  al.  (1985). 
The  satellite  moved  earthward  from  -14.8  to  -13.0  Re  geocentric  distance  at  -02(X)  local 
time  from  1010-1200  UT.  However,  the  published  observations  do  not  cover  the  entire 
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Table  4.3  Input  parameters  for  E-field  model  for  CDAW-6  interval. 


Figure  4.2  ISEE  2  plasma  and  magnetic  field  parameters  for  the  time  interval  1010-1200 
UT  on  March  22,  1979.  Tp  and  Tg  are  the  ion  and  electron  temperatures  (degrees 
Kelvin). 
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time  interval  we  want  to  model,  so  we  have  estimated  the  temperatures  from  the  data  and 
extrapolated  to  cover  the  rest  of  the  event.  TTie  top  of  Table  4.4  shows  the  invariant 
temperatures  calculated  for  the  entire  event.  The  headings  are 
Label  -  Time  label  of  magnetic  field  model  (See  Table  4.1). 
figure  ■  Time  of  ISEE-2  data  point  used  to  calculate  temperature. 

^figure  ■  Radial  distance  of  ISEE-2  (Re). 

VMnjodei  -  Flux  tube  volume  at  rfig^je  from  the  magnetic  field  model. 

Tj  (“K)  -  Estimated  ion  temperature  from  ISEE-2  data. 

Tg  (oK)  -  Estimated  electron  temperature  from  ISEE-2  data. 

XjjTi  -  Calculated  ion  invariant  temperature. 

^Te  -  Calculated  electron  invariant  temperature. 

<IXil>  -  average  value  of  ion  energy  invariant  ( =  1.5  x  )• 

<IX,gl>  -  average  value  of  electron  energy  invariant  ( =  1.5  x 
The  bottom  figure  shows  the  value  of  iltot  calculated  from  equation  3.24  in  Chapter 
3  at  a  distance  of  20  Re  and  local  midnight  The  headings  are 
UTnjodei  -  tiie  universal  time  of  the  model. 

®iobc^/  87r(model(20Re))  -  lobe  magnetic  pressure  at  20  Re  and  midnight 
VMjnodei  (20Re)  -  flux  tube  volume  at  20  Re  and  midnight. 

-  calculated  total  invariant  density  at  20  Re  and  midnight . 

The  initial  invariant  density  for  each  energy  channel  is  given  by  equation  3.31  in 
Chapter  3.  A  list  of  the  energy  channels  (K),  invariant  energy  (ALAM(K)),  and 
boundary  values  at  20  Re  and  local  midnight  (ETAB(K))  is  given  in  Table  4.5. 

4.  Initial  Plasma  Condition 

The  initial  plasma  condition  is  set  using  K=32,  the  highest  electron  energy  that  we 
model  and  it  corresponds  to  ~  40keV  at  geosynchronous  orbit.  Using  the  30-45  keV 
electron  channel  of  thel977-(X)7  and  1976-059  spacecraft  we  estimated  the  average  flux 
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Table  4.4  Invariant  temperature  and  total  invariant  density  calculated  from  CDAW-6  interval. 
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K 

ALAMfKl 

ETABfKl 

1 

374.80640 

0.86136E+20 

2 

1202.52612 

0.15263E+21 

3 

2146.50952 

0.19207E+21 

4 

3223.09546 

0.21585E+21 

5 

4450.89844 

0.22572E+21 

6 

5851.17187 

0.22246E+21 

7 

7448.13672 

0.20738E+21 

8 

9269.42187 

0.18272E+21 

9 

11346.53120 

0.15164E+21 

10 

13715.41020 

0.11792E+21 

11 

16417.03520 

0.85332E+20 

12 

19498.16410 

0.56979E+20 

13 

23012.07810 

0.34758E-h20 

14 

27019.57030 

0.19146E+20 

15 

31589.98440 

0.93944E+19 

16 

36802.38670 

0.62709E+19 

17 

-58.56357 

0.86136E+20 

18 

-187.89493 

0.15263E+21 

19 

-335.39233 

0.19207E+21 

20 

-503.60913 

0.21585E+21 

21 

-695.45410 

0.22572E+21 

22 

-914.24683 

0.22246E+21 

23 

-1163.77295 

0.20738E+21 

24 

-1448.34888 

0.18272E+21 

25 

-1772.89771 

0.15164E+21 

26 

-2143.03564 

0.11792E+21 

27 

-2565.16455 

0.85332E+20 

28 

-3046.59180 

0.56979E+20 

29 

-3595.64160 

0.34758E+20 

30 

-4221.81250 

0.19146E+20 

31 

4935.93750 

0.93945E+19 

32 

-5750.37891 

0.62709E+19 

Table  4.5  A  list  of  the  energy  channels  (K),  invariant  energy  (ALAM(K)),  and 
boundary  values  at  20  Re  and  local  midnight  (ETAB(K)). 
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to  be  10^  '^  cm  ^s'isr^eV-^  (See  Figure  4.3).  The  other  parameters  needed  to  solve 
equation  3.40  are: 

ALAM(K)  -  energy  invariant  for  energy  K=32;  =  -5750.4  (Re/nT)2/3 
VM  -  magnetic  flux  tube  volume  at  6.6  Re  on  dawn/dusk  meridian 
=  6.82  (Re/nT)-2/3 

^kmax  ■  defined  in  equation  3.33a  in  Chapter  3 
=  -7451.8  eV  (Re/nT)2/3 
^kmin  ‘  defined  in  equation  3.32b  in  Chapter  3 
=  -5343.2  (Re/nT)2/3 

Solving  for  EETA(32),  the  invariant  density  at  geosynchronous  orbit  is 
EETA(32)  =  1.666E17 

The  invariant  density  for  K=32  at  the  back  boundary  is  given  in  Table  4.4  as  0.627 1E19. 
The  initial  back  boundary  at  local  midnight  at  15.87  Re.  Solving  equation  3.42  in  Chapter 
3  to  get  the  power  law  coefficient: 

EETA(Geosynchronous)  _  1.666E17  _  J*  6.6  Re  T 

EETACBound^  0.627E19  “  '  [  15.87  Re  J 


p  =  4.134 

Previous  runs  have  shown  the  'Kivelson'  effect  is  not  important  for  40  keV  electrons  at 
local  midnight,  and  it  is  neglected  for  adjusting  the  ti  values.  Solving  equation  3.44  in 
Chapter  3,  the  revised  density  becomes 

4.134 


Tl,^j(r)  =  (1.966E21) 


r 

T5I7 


The  initial  density  values  for  entire  grid  are  calculated  using 


EETA.^,^  (K.I,J)  = 


Up  (midnight) 

■r(U)‘ 

1.966E21 

15.87 

4.134 


where  Tip(midnight)  is  the  initial  value  for  energy  species  K  at  midnight. 


Calculated  40  keV  geosynchronous  electron  flux  values  and  1977-077  and 
1976-059  observed  40  keV  electron  flux  values. 
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The  plasma  sheet  depletion  factor  (f|^)  defined  in  equation  3.35  of  Chapter  3  was  set 
to  5  and  was  activated  at  the  substorm  onset  at  10:54:01  UT. 

C.  Model  Results 

Figure  4.4  shows  the  time  evolution  of  the  invariant  density  (Ti)  in  the  equatorial 
plane  for  our  highest  energy  electrons  (-^0  keV  at  synchronous  orbit).  Figure  4.5  is  a 
similar  plot  for  "medium  energy"  ions  (-40  keV  at  synchronous  orbit);  and  Figure  4.6 
represents  low  energy  ions  (~2.5  keV  at  synchronous  orbit).  The  contours  represent 
contours  of  constant  T|;  that  is,  constant  numbers  of  particles  per  unit  magnetic  flux.  The 
contours  differ  by  a  factor  of  lO^-^  in  density  level.  In  the  plots,  the  sun  is  to  the  left. 

The  outermost  contour  represents  approximately  the  outer  boundary  of  our  calculations. 
Some  physical  features  include 

1 )  Collapse  of  the  magnetic  field  causes  the  inner  edge  of  the  plasma  sheet  near  local 
midnight  to  move  earthward  approximately  1  Re  at  the  onset  of  the  expansion  phase  of 
the  first  substorm  at  1054UT. 

2)  Electrons  drift  eastward  after  the  injection,  with  high  densities  reaching  local 
noon  at  approximately  1200UT. 

3)  Medium  energj'  ions  drift  westward  from  the  midnight  region,  leading  to  high 
densities  at  local  noon  beginning  about  1200UT. 

4)  Subsequently  the  afternoon  inner  edge  moves  gradually  earthward. 

The  output  from  the  model  was  compared  with  data  available  fiom  the  CDAW-6 
interval,  which  included 

1)  Available  data  from  geosynchronous  orbit 

a)  1-16  keV  ions  in  the  afternoon  sector  just  after  noon  UT  (GEOS-2) 

b)  40  keV  electrons  around  0200  LT  at  1  lOOUT  (1977-077) 

c)  40  keV  electrons  around  dawn  at  1 1(X)UT  (1976-056) 

2)  Low  orbit  data 


A,  =  5750  electrons  ("  40  keV  at  synchronous  orbit) 


UT  =  1130 


UT  =  1206 


Figure  4.4  Time  evolution  of  invariant  density  (ti)  in  the  uatorial  plan  for  highest 
energy  electrons  (~40  keV  at  geosynchronous). 


X  =  375  ions  (~  2.5  keV  at  synchronous  orbit) 
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UT  =  1130  UT  =  1206 


Figure  4.6  Time  evolution  of  invariant  density  (T|)  in  the  equatorial  plan  for  low  energy 
ions  (~2.5  keV  at  geosynchronous). 
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a)  Precipitating  electron  flux  from  DMSP 

Figure  4.3  shows  the  electron  flux  measured  at  the  geosynchronous  satellites  and 
compares  them  with  the  highest  electron  energy  channel  (K=32)  in  the  model  which 
corresponds  to  approximately  40  keV  at  geosynchronous  orbit.  The  arrival  times  of 
approximately  llOOUT  for  1977-077  and  1130UT  for  1976-059  show  good  agreement. 
However,  in  both  cases  the  fluxes  are  too  high  by  a  factor  of  2. 

The  ion  energy  channels  for  K=l,  2,  and  3  in  the  model  correspond  approximately 
to  geosynchronous  energies  of  2.5  keV,  8.0  keV,  and  15.0  keV  respectively.  A 
comparison  of  the  model  ion  flux  with  the  GEOS-2  data  is  shown  on  Figure  4.7.  Again 
the  arrival  times  and  energy  dispersion  aro  in  good  agreement  with  the  15  keV  ions 
arriving  around  1200UT,  8.0  keV  ions  arriving  around  1230UT,  and  the  2.5  keV  ions 
arriving  about  1330UT.  The  peak  fluxes  show  the  same  general  tendency  to  be  high  by 
about  a  factor  of  2. 

The  graphs  of  the  DMSP  precipitating  electron  energy  flux  are  given  as  Figures  4.8 
I  I  4.9.  The  model  values  normalized  to  the  data  are  represented  by  overlays.  The 
model  does  not  calculate  precipitation  in  the  region  poleward  of  our  main  modeling 
region;  that  excluded  region  includes  the  polar  cap  and  the  higher-latitude  part  of  the 
auroral  zone  so  this  is  not  included.  The  data  shown  in  Figure  4.8  are  for  the 
pre- substorm  period.  In  all  three  examples  both  the  shape  and  the  magnitude  of  the 
fluxes  agiee  well  with  the  satellite  data.  Figure  4.9  presents  the  results  after  the  substorm 
onset  and  Figure  4.10  is  the  substorm  recovery  period.  As  with  the  geosynchronous 
fluxes,  for  both  cases  the  magnitude  is  again  too  high  by  a  factor  of  2. 

D.  Interpretation  and  Implication 

This  model  represents  an  attempted  simulation  of  the  inner-magnetosphere  processes 
associated  with  magnetospheric  substonns,  including  the  magnetic  field  collapse  at  the 
onset  of  the  substorm  expansion  phase  and  the  subsequent  injection  of  particles  into 
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Figure  4.8  DMSP  precipitating  electron  energy  flux  before  substorm  onset. 
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geosynchronous  orbit.  The  arrival  times  of  the  electrons  near  dawn  and  the  ions  which 
have  drifted  to  noon  local  time  agree  with  the  satellite  data.  However,  assuming  that 
middle  plasma  sheet  flux  tubes  are  convected  adiabatically  through  the  inner  plasma  sheet 
to  synchronous  orbit  in  a  substorm  with  allowances  for  precipitation  loss,  the  model 
results  imply  unrealistically  high  synchronous  fluxes  and  unrealistically  high  precipitation 
rates.  In  addition,  the  modeled,  geosynchronous  40  keV  electron  flux  does  not  decrease 
during  the  recovery  phase  late  in  the  event  as  the  data  shows.  It  may  be  that  we  are 
underestimating  the  pitch-angle  scattering  rate  for  these  particles.  The  Hones  (1979) 
substorm  theory  implies  that  a  portion  of  the  plasma  on  tail-plasma-sheet  flux  tubes 
escapes  down  the  tail  as  a  plasmoid.  Therefore,  for  the  initial  model  runs,  we  decreased 
the  plasma  sheet  density  by  a  factor  of  2  at  substorm  onset  This  still  produced  fluxes 
and  precipitation  too  high  by  a  factor  of  5.  The  results  presented  here,  from  a  later  model 
run,  assume  a  factor-  of-  5  depletion  after  substonn  onset  The  model  predictions  and 
observations  agree  to  within  a  factor  of  2  in  flux  levels  and  precipitation.  The  implication 
is  that  the  substorm  process  must  involve  a  powerful  electron  loss  process  in  addition  to 
precipitation,  or  the  flux  tubes  which  convect  into  geosynchronous  orbit  have  previously 
been  depleted. 
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Test  Analysis  Report 


2.  TEST  ANALYSIS 


2.1  Test  The  set  of  algorithms  encoded  as  the  MSM  have  been  run  and  tested  at  Rice  University. 
The  results  have  been  studied  by  comparing  the  model  results  with  observed  data.  The  version  of 
the  program  code  which  was  develop^  at  Wee  University  gives  the  verified  results.  To  validate 
the  algorithms  delivered  to  the  Space  Forecast  Center,  the  output  from  the  code  run  at  Rice 
University  will  be  compared  with  that  run  at  the  Space  Forecast  Center. 


2. 1 .3  Performance.  Using  the  output  data  furnished  from  Rice  University,  the  output  from  the 
code  run  at  the  Space  Forecast  Center  should  be  the  same. 


3.  SUMMARY  AND  CONCLUSIONS 

3. 1  Demonstrated  Capability.  This  test  verifies  that  the  algorithms  developed  for  the  Air  Weather 
Service  at  Rice  University  are  running  properly  at  the  Space  Forecast  Center. 
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Database  Specification 


2.1  Database  Identification. 


AWS  Environmental  Database  -  Presently  all  the  input  data  are  on  disk  files,  some  of  which  will 
no  longer  be  needed  when  the  Environmental  Data  Base  is  operational.  Attached  is  a  listing  of  the 
input  parameters  needed  to  run  the  MSM  and  a  proposed  data  transfer  method. 

MSM  Database  -  Below  is  a  list  of  the  input  files  needed  to  restart  the  model. 


BOxxxxxx 

COORD 

DKTABLE 

EFCOEF 

ENCHAN 

HARDY 

lONENG 

lONNUM 

MSMIN 


The  magnetic  field  matrices  needed  for  the  model  run. 

File  of  values  to  set  up  the  coordinate  system. 

Decay  times  for  computing  charge-exchange  loss  of  ions 

Coefficients  from  Heppner-Maynard  model  which  are  input  to  the  electric  field 

model. 

Input  values  for  the  number  of  energy  channels,  particle 
type  and  energy  channels  for  the  model  to  simulate. 

Coefficients  used  by  the  Hardy  precipitating  electron  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

(km/sec) 

Input  start  and  stop  times,  stan  direct-access  record  number,  and  sunspot 
number 


Following  is  a  list  of  files  output  from  the  MSM. 


V 

VNORTH 

VSOUTH 

VM 

BMIN 

XMIN 


Output  volume  -  number  of  latitudinal 
gridpoints  x  number  of  time  steps  x  4 
Output  volume  -  number  of  latitudinal 
gridpoints  x  number  of  time  steps  x  4 
Output  volume  -  number  of  latitudinal 
gridpoints  x  number  of  time  steps  x  4 
Output  volume  -  number  of  latitudinal 
gridpoints  x  number  of  time  steps  x  4 
Output  volume  -  number  of  latitudinal 
gridpoints  x  number  of  time  steps  x  4 
Output  volume  -  number  of  latimdinal 
gridpoints  x  number  of  time  steps  x  4 


gridpoints  x  number  of  longitudinal 
(bytes) 

gridpoints  x  number  of  longitudinal 
(bytes) 

gridpoints  x  number  of  longitudinal 
(bytes) 

gridpoints  x  number  of  longitudinal 
(bytes) 

gridpoints  x  number  of  longitudinal 
(bytes) 

gridpoints  x  number  of  longitudinal 
(bytes) 
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YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 

EAVG 

AUGPAR 

COLAT 

ALOCr 

FLUX 


Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Output  volume  -  number  of  longitudinal  gridpoints  x  number  of  time  steps  x  4 
(bytes) 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 
Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Output  volume  -number  of  data  elements  x  number  of  time  steps  x  4  (bytes) 
Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 


2.3.1  Conceptual  Model.  The  MSM  will  interrogate  the  Environmental  Data  Base  at  mark  times 
for  all  physical  parameters  needed  by  the  model.  Attached  is  a  copy  of  the  MSM  Control  and  Data 
Flow  Diagram.  Subroutine  PARGEN  within  the  MSM  code  will  interpolate  or  extrapolate  as 
necessary  to  adjust  the  data  to  the  model  time.  Subroutine  FECON  then  calculates  the  parameters 
needed  within  the  program.  The  model  is  capable  of  running  with  no  data  except  Kp.  If  Kp  is 
missing,  the  program  so  states  and  stops. 

Data  from  previous  MSM  runs  is  communicated  through  the  direct-access  record  number  read  in 
file  MSMIN.  It  specifics  at  which  time  label  of  the  previous  run  to  begin  the  current  run.  Zero 
means  the  start  of  a  new  run. 


3.3.2  Content. 


BOxxxxxx 

COORD 


The  magnetic  field  matrices  needed  for  the  model  run. 
File  of  values  to  set  up  the  coordinate  system. 


DATABASE  SPECIHCATION  -  3 


EFCOEF 

ENCHAN 

HARDY 

lONENG 

lONNUM 


Coefficients  from  Heppner-Maynard  model  which  are  input  to  the  electric  field 
model. 

Input  values  for  the  number  of  energy  channels,  particle 
type  and  energy  channels  for  the  model  to  simulate. 

C^fficients  used  by  the  Hardy  precipitating  electron  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

Coefficients  used  as  input  for  the  ion  precipitating  model. 

(km/sec) 


Following  is  a  list  of  files  output  from  the  MSM. 


V 

VNORTH 

VSOUTH 

VM 

BMIN 

XMIN 

YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 


EAVG 

AUGPAR 

COLAT 

ALOCT 

FLUX 


Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts). 

Northern  hemisphere  electric  potential  distribution  (Volts). 

Southern  hemisphere  electric  potential  distribution  (Volts). 

Flux  tube  volume  ((Re/nT)'2/3) 

Equatorial  magnetic  field  strength  (nT). 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Location  of  outer  boundary  of  detailed  panicle  traces. 

Precipitating  energy  flux  array  (ergs/cm^-sec). 

Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  H'*'  and  (3)  O'*")  (ergs/cm^-sec). 

Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H'*'  and  (3)  ©'•'(eV). 
Augmented  data  array  for  input  values. 

Grid  colatitude  array  (radians). 

Grid  local  time  array  (radians  eastward  from  noon). 

Flux  values  for  all  energy  channels  at  all  grid  points 


PARAMETER  I  NAME  |  UNITS  |K)1  TimcTag  I  Geo.  Latitude  |  Geo.  Longitude  |  AUitude 


P*ge 


Data  Transfer  Method 


1 .  MSM  will  access  the  environmental  database  input  data  files 
by  calling  a  subroutine,  INDATA. 

2.  Tlie  call  will  be  of  the  fonn: 

CALL  INDATA(pann-name.  STARTT,  ENDT,  NDIM,  DARRY, 

NUMNUM) 

Where; 

parm-name  is  a  valid  parameter  name  from  the  MSM  input  parameter  list 
STARTT  is  the  starting  time  for  this  data  request. 

ENDT  is  the  ending  time  for  this  data  request. 

NDIM  is  the  horizontal  dimension  of  DARRYand  the  maximum  number  of  dafa 
points  that  may  be  returned. 

DARRY  is  a  two  dimensional  array  to  be  retrieved 

from  the  database.  The  form  of  DARRY  is  shown  on  the  next  page.  The  size  of 
DARRY  AvUl  be  NDIM  by  7. 

NUMNUM  is  the  number  of  data  values  placen  in  DARRY  by  INDATA. 

3.  The  system  controller  will  periodically  update  the  input 
data  files. 

4.  Rice  does  not  plan  to  write  INDATA. 

5.  All  parameters  will  be  in  single  precision,  floating  point  format. 

6.  Output  data  will  be  passed  from  MSM  to  the  environmental 
database  via  a  subroutine,  OTDATA. 

7.  The  call  to  OTDATA  will  be  defined  similarly  to  INDATA. 

8.  Rice  does  not  plan  to  write  OTDATA. 


Format  for  DARRY 


NDIM  - ► 


Data  value  at  t1 

Data  value  at  t2 

Data  value  at  t3 

Etc. 

Time  tag  at  t1 

Time  tag  at  t2 

Time  tag  at  t3 

Latitude 

Latitude 

Latitude 

Longitude 

Longitude 

Longitude 

Altitude 

Altitude 

Altitude 

mag.  local  time 

mag.  local  time 

mag.  local  time 

jwf 


March  14,  1989 
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Implementation  Procedures 


3.1.5  Detailed  Procedures.  Following  are  the  files  needed  to  run  the  MSM,  including  those  to  be 
replaced  by  calls  to  the  environmental  data  base.  Those  required  for  a  restart  are  so  labelled. 


BOxxxxxx 

CLAPSE 


COORD 

DST 

DKTABLE 

EFCOEF 

ENCHAN 

EQEDGE 

FKP 

HARDY 

lONENG 

lONNUM 

MSMDM 

PCP 

SWDEN 

SWVEL 

XIPATT 

V 


VNORTH 


The  magnetic  field  matrices  needed  for  the  model  run.  Required  for  restart. 
File  containing  values  giving  the  collapse/no  collapse  state  of  the 
magnetosphere.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete. 

File  of  values  to  set  up  the  coordinate  system.  Required  for  restart. 

Dst  values  for  the  event.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (nT). 

Decay  times  for  computing  charge-exchange  loss  of  ions 

Coefficients  from  Heppner-Maynard  model  which  are  input  to  the  electric  field 

model.  Required  for  restart. 

Input  values  for  the  number  of  energy  channels,  particle 
type  and  energy  channels  for  the  m^el  to  simulate.  Required  for  restart. 
Values  of  the  equatorward  edge  of  the  auroral  oval  at  midnight  used  as  input 
into  the  electric  field  model.  To  be  replaced  by  call  to  AWS  environmental  data 
base,  when  complete  (degrees). 

Kp  data  for  the  event  To  be  replaced  by  call  to  AWS  environmental  data  base, 
when  complete.  Required  for  restart. 

Coefficients  used  by  the  Hardy  precipitating  electron  model.  Required  for 
restart 

Coefficients  used  as  input  for  the  ion  precipitating  model.  Required  for  restart. 
Cloefficients  used  as  input  for  the  ion  precipitating  model.  Required  for  restart. 
Input  start  and  stop  times,  start  direct-access  record  number,  and  sunspot 
number 

Qoss-polar  cap  potential  values  for  event  used  as  input  to  the  electric  field 
model.  To  be  replaced  by  call  to  AWS  environmental  data  base,  when 
complete  (kV). 

Solar  wind  density  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(particles/cm^) 

Solar  wind  velocity  values  used  to  calculate  the  standoff  distance  for  the  event. 
To  be  replaced  by  call  to  AWS  environmental  data  base,  when  complete, 
(km/sec) 

Polar  cap  pattern  type  used  as  input  to  electric  field  model  for  the  event.  To  be 
replaced  by  call  to  AWS  environmental  data  base,  when  complete. 

Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Northern  hemisphere  electric  potential  distribution  (Volts). 
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VSOUTH 

VM 

BMIN 

XMIN 

YMIN 

ZMIN 

BNDLOC 

EFLUX 

FLXSUM 

EAVG 

AUGPAR 

COLAT 


Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Southern  hemisphere  electric  potential  distribution  (Volts). 

Output  volume  -  number  of  ladtudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Flux  tube  volume  ((Re/nT)-2^). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Equatorial  magnetic  field  stren^  (nT). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  4  (bytes) 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

Location  of  outer  boundary  of  detailed  particle  traces. 

Output  volume  -  number  of  longitudinal  gridpoints  x  number  of  time  steps  x  4 
(bytes) 

Precipitating  energy  flux  array  (ergs/cm^-sec). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 
Tottd  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  and  (3)  0+)  (ergs/cm^-sec). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H+  and  (3)  0''’(eV). 
Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  3  particle  species  x  4  (bytes) 

Augmented  data  array  for  input  values. 

Output  volume  -number  of  data  elements  x  number  of  time  steps  x  4  (bytes) 
Grid  colatitude  array  (radians). 
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Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

ALCXJT  Grid  local  time  array  (radians  eastward  from  noon). 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 

gridpoints  x  number  of  time  steps  x  4  (bytes) 

FLUX  Flux  values  for  all  energy  channels  at  all  grid  points 

Output  volume  -  number  of  latitudinal  gridpoints  x  number  of  longitudinal 
gridpoints  x  number  of  time  steps  x  number  of  energy  channels  x  4  (bytes) 


4.1.2  Detailed  Procedures.  ToruntheMSM: 


Start  and  stop  times  are  specified  to  the  program  through  the  5  line  MS  MIN  file.  Following  is  an 
example  of  MS  MIN  for  Ae  fresh  startup  of  the  program. 


1988  112  64800 
1988  112  66600 
0 

'30  minute  test  run' 
0.0 


'start  year,  start  day,  start  time  (seconds)' 

'  end  year,  end  day,  end  time  (seconds)' 
'direct-access  record  number  0  means  new  start' 
'up  to  80  character  run  identification' 

'sunspot  number=0.' 


The  MSMIN  configuration  given  above  would  ron  the  MSM  for  a  30  minute  period  from  1800 
hours  on  day  1 12  of  1988  to  1830  on  the  same  day.  The  sunspot  number  is  zero. 


To  restart  the  MSM  from  1830  (direct-access  record  number  3)  and  run  until  2000  UT,  the 
following  MSMIN  file  would  be  used: 


1988  112  66600 
1988  112  72000 
3 

'MSM  restart  from  1830  on  day  112' 

0.0 


Input  file  ENCHAN  controls  how  many  and  which  energy  channels  are  calculated.  The  file  set  up 
is: 


Number  of  energy  channels  to  be  modeled  (maximum  30,integer) 
Particle  type  1  (integer).  Energy  1  (floating  point) 

Particle  type  2  (integer).  Energy  2  (floating  point) 

Particle  type  n  (integer).  Energy  n  (floating  point) 


The  sKxeptable  particle  type  input  is: 
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1  electrons 

2  H+ 

3  Cr 

The  energy  is  at  geosynchronous  orbit  in  keV.  The  energies  must  be  in  ascending  order,  with 
particle  types  grouped  together,  which  are  checked  within  the  program. 

For  example, 

4 

140 

1  55 

2  10 
2  15 

This  is  to  model  4  energy  channels,  the  first  two  are  electrons  of  40  and  55  keV  at  geosynchronous 
orbit.  The  second  two  are  ions  of  10  and  15  keV  energy  at  geosynchronous  orbit. 
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Maintenance  Manual 


2.1  System  Application.  The  Magnetospheric  Specification  Model  was  developed  as  a  set  of 
algorithms  to  be  incorporated  into  a  real-time  program  for  use  in  the  U.S.  Air  Force  Air  Weather 
Service  Space  Forecast  Center.  It  is  intended  to  help  Space  Forecast  Center  personnel  perform 
their  mission  of  providing  information,  particularly  during  magnetospheric  disturbances,  to 
"customers"  who  operate  spacecraft.  The  output  of  the  model  includes  (but  is  not  limited  to): 

1)  Fluxes  of  electrons  and  ions  in  the  inner  plasma  sheet  and  the  geosynchronous  orbit 
region. 

2)  Energy  fluxes  and  characteristic  energies  of  electrons  precipitated  into  the  auroral 
ionosphere. 


2.2  System  Organization.  The  model  uses  separate  ionospheric  electric-field  and  magnetospheric 
magnetic  field  models  to  trace  particle  trajectories  in  the  magnetosphere  equatorial  plane.  The 
following  flowchart  shows  the  major  components  of  the  model  and  how  they  are  related. 


4.1  Conventions.  None. 

5.1.1  Description.  See  following  pages. 
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MSMCON 

a.  Functions  -  The  MSM  control  program  MSMCON  provides  dimensioning  of  the  arrays  used 
throughout  the  program,  and  the  initial,  end  and  increments  of  time  information  for  all  other 
subroutines  of  Ae  program.  It  also  accesses  the  high  energy  particle  tracing  routines. 


b.  Input 


ISTART(l) 

ISTART(2) 

ISTARTO) 

lEND(l) 

IEND(2) 

IEND(2) 

IINC(l) 

IINC(2) 

IINC(3) 

IRECEB 

IRECPT 


Start  Year  (last  two  digits) 

Start  Day  (Julian  day)  Janur  .7  1  is  day  1 . 

Start  Time  (seconds) 

End  Year  (last  two  digits) 

End  Day  (Julian  day)  January  1  is  day  1. 

End  Time  (seconds) 

Program  time  step  increment  (year) 

Program  time  step  increment  (day) 

Program  time  step  increment  (seconds) 

For  restart,  record  number  of  previously  calculated  electric  and  magnetic  field 
output  data  to  use  as  input  for  current  run 

For  restart,  record  number  of  previously  calculated  particle-trace  output  data  to 
use  as  input  for  current  run 


c.  Processing  -  following  is  a  list  of  subroutines  called  and  their  major  function: 

PPTCON  Main  control  program  for  model 

HIEPAR  High  energy  electron  subroutine,  currently  a  dummy  routine  pending  computer 
code  from  sources  outside  Rice  University. 

OUTPUT  Output  routine  to  interface  with  Space  Forecast  Center  Environmental  Database. 
Currently  a  dummy  routine. 

See  the  flowchart  on  the  following  page  for  the  logic  flow  of  the  subroutine. 

Global  parameters  for  the  run  are  set  in  this  routine  and  are  as  follows: 


LATDINi 

LTDIM 

lEDIM 

ITMDIM 

NAUGEL 

IRDIM 

NRGDIM 

KPDIM 

KPPLUS 


Number  of  latitudinal  grid  lines  (aliased  as  EDIM  in  some  routines) 

Number  of  local  time  (longitude)  grid  lines  (aliased  as  JDIM  in  some  routines) 
Number  of  invariant  energy  species  traced  by  the  program 
Maximum  number  of  major  time  steps  per  run  of  the  program 
Number  of  elements  in  the  augment^  input  array 

Number  of  R  values  for  which  the  empirical  flux  array,  FLXMAT,  is  calculated 
Number  of  preset  energy  values  for  which  FLXMAT  is  calculated 
Number  of  KP  values  for  which  FLXMAT  is  calculated 
Kp  dimension  of  the  augmented  FLXMAT  array  (KKPLUS  =  KPDIM  +  2) 
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ISPDIM 

IRDK 

INRGDK 

ISOLDK 

lONDK 


Number  of  plasma  mass  species  (electrons,  O^,  etc.) 

R  dimension  of  DKTIME  array 

Energy  dimension  of  DKTlNffi  array 

Sun  spot  number  dimension  of  DKTIME  array 

Number  of  ion  species  in  DKTIME  array 


d.  Output  None.  All  output  is  currently  handled  by  other  subroutines. 
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PPTCON 

a.  Functions  •  wain  control  program  for  the  electric  and  magnetic  field  models  and  the  running  of 
the  particle  trace  algorithm. 


b.  Input  - 
ISTART 
IINC 
END 
LATDIM 
LTDIM 
EDIM 
ITMDIM 
IRDK 
INRGDK 
ISOLDK 
lONDK 
IRDIM 
NRGDIM 
KPDIM 
KPPLUS 
ISPDIM 


Start  year,  day,  and  time  (sec) 

Major  time  step  increment  (year,  day,  time) 

Ending  year,  day,  and  time  (sec) 

NumbCT  of  latitundinal  grid  spaces 

Number  of  local  time  (longitundinal)  grid  spaces 

Number  of  particle  species  to  be  traced 

Maximum  number  of  major  time  steps  for  this  run 

R  dimension  of  DKTIME  array 

Energy  dimension  of  DKTIME  array 

Sun  spot  number  dimension  of  DKTIME  array 

Number  of  ion  species  in  DKTIME  array 

R  dimension  of  FLXMAT  arrays 

Energy  dimension  of  FLXMAT  arrays 

KP  dimension  of  FLXMAT  arrays 

Kp  dimension  of  the  augmented  FLXMAT  array  (KKPLUS  =  KPDIM  +  2) 
Plasma  mass  species  dimension 


c.  Processing  -  following  is  a  list  of  subroutines  called  and  their  major  function: 


RDGRID 

OUTP 

FLXNIT 

DTIME 

EBCON 

EPREAD 

SETALM 


BNDSET 

RDHDR 

INTTAL 

PPTM 


Subroutine  to  read  grid  system  coordinates  and  calculate  essential  grid  quantities 

Utility  subroutine  to  print  out  array  information 

Subroutine  to  calculate  Kp-basal  particle  number  flux  in  units  of 

particles/cmVs/sr/eV  as  function  of  R,  energy  and  Kp 

Routine  which  returns  current  system  time 

Executive  routine  to  control  calculation  of  electric  and  magnetic  field  models 
Dummy  routine  to  read  satellite  flux  data  -  to  be  replaced  by  call  to 
environmental  data  base  when  program  is  operational 
Subroutine  to  read  the  number  of  energy  channels  and  their  energies  at 
geosynchronous  orbit  and  calculate  the  energy  invariant  species  needed  to  run 
die  pro^m 

Subroutine  to  compute  boundary  plasma  distribution 

Subroutine  to  read  the  header  record  of  the  standard  MSM  disk  file  format 

Subroutine  to  compute  initial  plasma  distribution 

Subroutine  to  trace  particle  trajectories  from  each  grid  point  for  each  particle 
species  back  in  time  from  time=TSTART  to  time=TSTOP 
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FLXDFL  Subroutine  to  calculate  the  energy-dependent  ETA  array  from  Kp  and  the 

location  of  the  grid  points  by  interpolating  the  empirical  FLXMAT  array  -  this 
routine  is  used  as  the  MSM  default  model  when  full  particle  traces  are  not  done 
AURLl  Subroutine  to  determine  default  Hardy  precipitating  electron  flux 
AURL2S  Subroutine  to  determine  default  Hardy  precipitating  ion  flux 
PWRCAL  Subroutine  to  estimate  precipitating  electron  energy  flux  poleward  of  the  main 
MSM  modeling  region  by  comparing  flux  within  modeling  region  with  Hardy 
statistical  values 

WRT3D  Subroutine  to  write  3-d  arrays  into  the  standard  MSM  disk  file  format 

READ3D  Subroutine  to  read  3-d  arrays  from  the  standard  MSM  disk  file  format 

RDVEC  Subroutine  to  read  header  vector  from  standard  MSM  disk  file  format 

WRTVEC  Subroutine  to  write  header  vector  from  standard  MSM  disk  file  format 

OPTERR  Subroutine  to  calculate  standard  deviation  and  error  of  the  model  flux  and 

available  observed  geosynchronous  satellite  data 

See  the  following  flow-chart  for  the  logical  structure  of  the  subroutine. 


d.  Output  - 


FLXR  R  values  at  which  FLXMAT  arrays  are  calculated  (Re) 

FLXNRG  Energy  values  for  which  FLXMAT  arrays  are  calculated  (logio(eV)) 

FLXKP  KP  values  for  which  FLXMAT  arrays  are  calculated 
FLXMAT  Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  in 
calculating  initial  and  boundary  flux  values  (log]o(#/cm2-s-ster-eV)) 

THRMAT  Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  as  threshold 
fluxes.  (logio(#/cm2-s-ster-eV)) 

CHID  Character  header  string  (up  to  80  characters) 

ID  Integer  header  vector 

ID(l)  =  Year 
ID(2)  =  Day 
ED(3)  =  Hours 
ID(4)  =  Minutes 
ID(5)  =  Seconds 
ID(6)  =  Presently  unused 
ID(7)  =  Presently  unused 
ID(8)  =  First  dimension  of  output  array 
ID(9)  =  Second  dimension  of  output  array 
ID(IO)  =  Third  dimension  of  output  array 
ID(1 1)  =  Time  index  L 
ID(12)  -  ID(20)  =  Presently  unused 
RID  Real  header  vector 

RID(l)  =  TIMTAG  (seconds) 

RID(2)  =  KP 

RID(3)  =  Polar  cap  potential  drop  (kV) 
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SCTFRC 

IFLAV 


BNDMAX 

ALPHA 

BETA 

TETA 

PHI 

BIR 

SINI 

TIMTAG 

COLAT 

ALOCT 

V 

VNORTH 

VSOUTH 

ASOUTH 

BSOUTH 

DXS 

DYS 

ANORTH 

BNORTH 

DXN 

DYN 

VM 

VMLOSS 

BMIN 

XMIN 

YMIN 

ZMIN 

ALAM 

ETABEG 

ETABND 

FLXBND 

BNDLOC 

ETA 


RID(4)  =  Time  derivative  of  location  of  low-latitude  edge  of  auroral 
precipitation  (degrees/hour) 

RID(5)  -  RID(20)  =  lYesently  unused 
Assumed  pitch  angle  scattering  efficiency 
Chemical  species  identifier 

1  means  electrons 

2  means  H"*"  ions 

3  means  O'*'  ions 

Maximum  I  value  of  model  boundary  along  each  local  time  grid  line  during  the 
duration  of  this  run. 

Latitundinal  grid  spacing  vector 
Longitudinal  grid  spacing  vector 
Colatitude  of  I  grid  lines  (radians) 

Non-rotated  hour  angle  of  J  grid  lines  (radians) 

Radial  component  of  ionospheric  magnetic  field  (nT) 

SIN(Magnetic  field  inclination  angle) 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated  (seconds) 

Grid  colatitude  array  (radians) 

Grid  local  time  array  (radians  eastward  from  noon) 

Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts) 

Northern  hemisphere  electric  potential  distribution  (Volts) 

Southern  hemisphere  electric  potential  distribution  (Volts) 

Southern  hemisphere  radius  of  ellipse  measured  in  x  (sunward)  direction 
Southern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Southern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Southern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Northern  hemisphere  radius  of  ellipse  measured  in  x  (sunward)  direction 
Northern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Northern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Northern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Flux  tube  volume  ((Re/nT)'2/3) 

Geometric  factor  used  in  calculating  precipitation  loss 
Equatorial  magnetic  field  strength  (nT) 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 

Energy  invariant  vector  (eV(Re/nT)2/3) 

Initial  flux  tube  content  distribution  each  time  step  (weber*) 

Boundary  flux  tube  content  distribution  (weber*) 

Flux  at  boundary  (cm2  second)' * 

Location  of  outer  boundary  of  detailed  particle  traces 
Flux  tube  content  array  (weber*) 
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FLUX 

EFLUX 

FLXSUM 


EAVG 

R 

P 

ALMDEL 

NAUGEL 

AUGPAR 

MODE 

RPP 

THRSH 

ERSHFT 

DKTIME 


Flux  (cm2  second)'^ 

Precipitation  energy  flux  array  (ergs/cm^-sec) 

Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  H"*"  and  (3)  O’*")  (ergs/cm^-sec) 

Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H''"  and  (3)  0'''(eV) 

Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 

Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of  grid  pts 

in  equatorial  plane 

Width  of  energy  invariant  channels 

Dimension  of  input  airays 

Augmented  data  array  for  input  values 

Logical  variable  telling  which  input  parameters  we  have  values  for 
Nominal  radius  of  plasmapause  defined  as  dipole  mappine  of  equatorward  edge 
of  auroral  zone  to  magnetospheric  equatorial  plane  (Re) 

Vector  giving  full-tracebacl^default  flux  information 
Vector  of  error  values 

Array  giving  charge  exchange  decay  times  (seconds)  for  an  array  of  radial 
distances,  energies,  sunspot  numbers,  and  species 
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EBCON 

a.  Functions  -  EBCON  calls  routines  to  calculate  the  electric  and  magnetic  field  at  our  grid  points 
for  all  time  labels  for  this  run. 


b.  Input - 


ISTART 

IINC 

END 

COLAT 

ALOCT 

LATDIM 

LTDIM 

ITMDIM 

EDIM 

NAUGEL 

CHID 

BIR 

SINI 

EMAX 

TETA 


Start  year,  day,  and  time  (sec) 

Major  time  step  increment  (year,  day,  time) 

Ending  year,  day,  and  time  (sec) 

Grid  colatitude  array  (radians) 

Grid  local  time  array  (radians  eastward  from  noon) 

Number  of  latitudinal  grid  lines  (aliased  as  IDIM  in  some  routines) 

Number  of  local  time  (longitude)  grid  lines  (aliased  as  JDIM  in  some  routines) 

Maximum  number  of  major  time  steps  per  run  of  the  program 

Number  of  invariant  energy  species  traced  by  the  program 

Number  of  elements  in  the  augmented  input  array 

Character  header  string  (up  to  80  characters) 

Radial  component  of  ionospheric  magnetic  field  (nT) 

SIN(Magnetic  field  inclination  angle) 

Maximum  number  of  energy  channels 
Colatitude  of  I  grid  lines  (radians) 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  function: 


FECON 

MLTSET 

SETSCT 

BTRACE 


EFBNDY 

EFELD 


OUTP 

FNDBND 

G3NTRP 

VMLSET 

WRT3D 


Subroutine  to  obtain  time-normalized  observational  values 
Subroutine  to  calculate  time  dependent  ALOCT  of  rotating  grid  points 
Subroutine  to  set  species  dependent  pitch  angle  scattering  efficiency 
Subroutine  to  calculate  magnetic  field  models  appropriate  for  geophysical 
conditions  as  specified  by  standoff  distance,  equatorward  edge  of  the  auroral 
zone,  Dst,  tail  collapse,  and  tilt  angle 

Subroutine  to  calculate  latitudes  and  widths  of  electric  field  model  boundarys  2 
and  3 

Subroutine  to  return  values  of  the  potential  on  the  northern  hemisphere  grid 
(VNORTH),  on  the  southern  hemisphere  grid  (VSOUTH),  and  the  average  of 
the  two  hemispheres  (V) 

Utility  subroutine  to  print  out  array  information 

Subroutine  to  compute  time  dependent  outer  boundary  location 

Utility  function  subprogram  to  perform  a  general  3-d  linear  interpolation  of  an 

arbitrary  array  A(I,J,K)  at  point  (BI,BJ,BK) 

Subroutine  to  calculate  VNEOSS  array 

Subroutine  to  write  3-d  arrays  into  the  standard  MSM  disk  file  format 
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d.  Outputs  - 
ID 


RID 


VM 

BMIN 

XMIN 

YMIN 

ZMDSf 

V 

VNORTH 

VSOUTH 

ASOUTH 

BSOUTH 

DXS 

DYS 

ANORTH 

BNORTH 

DXN 

DYN 

BNDLOC 

TIMTAG 

ITMMAX 


Integer  header  vector 

ID(l)  =  Year 

ID(2)  =  Day 

ID(3)  =  Hours 

ID(4)  =  Minutes 

ID(5)  =  Seconds 

ID(6)  =  Presently  unused 

ID(7)  =  Presently  unused 

ID(8)  =  First  dimension  of  output  array 

ID(9)  =  Second  dimension  of  output  array 

ID(IO)  =  Third  dimension  of  output  array 

ID(1 1)  =  Time  index  L 

ID(12)  -  ID(20)  =  Presently  unused 

Real  header  vector 

RID(l)  =  TTMTAG  (seconds) 

RID(2)  =  KP 

RID(3)  =  Polar  cap  potential  drop  (kV) 

RID(4)  =  Time  derivative  of  location  of  low-latitude  edge  of  auroral 
precipitation  (degrees/hour) 

RID(5)  -  RID(20)  =  Presently  unused 
Flux  tube  volume  (weber*) 

Equatorial  magnetic  field  strength  (nT) 

GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 

GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 

GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 

Electric  potential  distribution  on  grid  (average  of  VNORTH  and  VSOUTH) 
(Volts) 

Northern  hemisphere  electric  potential  distribution  (Volts) 

Southern  hemisphere  electric  potential  distribution  (Volts) 

Southern  hemisphere  radius  of  ellipse  measured  in  x  (sunward)  direction 
Southern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Southern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Southern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Northern  hemisphere  radius  of  ellipse  measured  in  x  (sunward)  direction 
Northern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Northern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Northern  hemisphere  radius  of  ellipse  measured  in  y  (duskward)  direction 
Location  of  outer  boundary  of  detailed  particle  traces 
Vector  giving  times  at  which  E  and  B  parameters  are  calculated  (seconds) 
Maximum  number  of  time  labels 
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R 

P 

VMLOSS 

SCTFRC 

AUGPAR 

MODE 

RPP 


Array  givmg  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 
Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of  grid  pts 
in  equatorial  plane 

Geometric  factor  used  in  calculating  precipitation  loss 
Assumed  pitch  angle  scattering  efficiency 
Augment^  data  array  for  input  values 

Logical  variable  telling  which  input  parameters  we  have  values  for 
Nominal  radius  of  plasmapause  defined  as  dipole  mapping  of  equatorward  edge 
of  auroral  zone  to  magnetospheric  equatorial  plane  (Re) 
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BLOCK  DATA 

a.  Functions  -  Block  data  containing  the  index  of  data  elements  and  connections  between  the 
logical  unit  number  and  names.  Sets  I,  J,  and  energy  indices  for  locations  and  species  to  be  traced. 


b.  Input  -  none. 


c.  Processing  -  No  other  subroutines  are  called. 

The  block  data  contains  the  data  element  assignments  (for  example  for  the  AUGPAR  vector) 
and  connects  the  logical  unit  number  to  the  name  within  the  program. 


d.  Ouput  -  the  following  assignments  are  made: 

Elements  in  the  input  data  array 

1  Year 

2  Day 

3  Seconds  of  day 

4  Minute 

5  Seconds 

6  Kp 

7  Dst  (nT) 

8  Equatorward  edge  of  auroral  zone  at  midnight  (degrees) 

9  Low  latitude  boundary  of  auroral  zone  (degrees) 

10  Equatorward  edge  of  Region  2  currents  (degrees) 

1 1  Currently  unused 

12  Bx  component  of  interplanetary  magnetic  field  (nT) 

13  By  component  of  interplanetary  magnetic  field  (nT) 

1 4  Bz  component  of  interplanetary  magnetic  field  (nT) 

1 5  Magnetotail  collapse  parameter 

16  X  component  of  geosynchronous  magnetic  field  data  (nT) 

17  Y  component  of  geosynchronous  magnetic  field  data  (nT) 

18  Z  component  of  geosynchronous  magnetic  field  data  (nT) 

19  Currently  unused 

20  Currently  unused 

21  Solar  wind  velocity  (km/sec) 

22  Solar  wind  density  (prot/cm^) 

23  Tilt  angle  (degrees) 

24  Standoff  distance  (Re) 

25  Cross  polar  cap  potential  drop  (kV) 

26  Electric  field  pattern  type 

27  Time  rate  of  change  of  Dst  (nT/hour) 
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28  Time  rate  of  change  of  the  equatorward  edge  of  the  auroral  oval  at  midnight 

(degrees/hour) 


Elements  in  the  logical  unit  assignment: 

9  LUERR  -  Error  output 

13  LUPPT  -  Not  currently  used 

14  LUCORD  -  Coordinate  data 

15  LUPRNT  -  Output  to  printer 

16  LUIDAT  -  Not  currently  used 

17  LUHDYE  -  Coefficients  to  calculate  electron  precipitating  energy  and  number 
flux  in  default  model 

20  LUDK  -  charge  exchange  decay  parameter  file 

21  LUETAB  -  ETABND  file  (boundary  flux  tube  content  distribution) 

22  LUEBEG  -  ETABEG  file  (initial  flux  tube  content  distribution  each  time  step) 

23  LUSHFT  -  error  correction  factor  file 

24  LUPION  -  Not  currently  used 

25  LUEAVG  -  EAVG  file  (average  precipitating  electron  energy  for  (1)  electrons, 
(2)  H+  and  (3)  0+) 

26  LUFLSM  -  FLXSUM  file  (total  precipitation  energy  flux  array  (integrated  over 
species  for  (1)  electrons,  (2)  H+  and  (3)  0+) 

27  LUFLX  -  FLUX  file  (particle  flux  array ) 

28  LUEFLX  -  EFLUX  file  (precipitation  energy  flux  array) 

35  LUEFLD  -  V  file  (electric  potential  distribution  on  grid  (average  of  VNORTH 
and  VSOUTH) 

36  LUBFLD  -  VM  file  (flux  tube  volume) 

37  LUBMIN  -  BMIN  file  (equatorial  magnetic  field  strength  (nT)) 

38  LUXMIN  -  XMIN  file  (GSM  X  location  of  where  field  line  going  through  grid 
pt  crosses  the  equatorial  (B-field  minimum)  plane) 

39  LUYMIN  -YMIN  file  (GSM  Y  location  of  where  field  line  going  through  grid 
pt  crosses  the  equatorial  (B-field  minimum)  plane) 

40  LUZMIN  -ZMIN  file  (GSM  Z  location  of  where  field  line  going  through  grid  pt 
crosses  the  equatorial  (B-field  minimum)  plane) 

41  LUALOC  -  ALOCT  file  (grid  local  time  array  (radians  eastward  from  noon)) 

42  LUCOLT  -  COLAT  file  (grid  colatitude  array  (radians)) 

43  LUBNDL  -  BNDLOC  file  Oocation  of  outer  boundary  of  detailed  particle 
traces) 

44  LUPDAT  -  AUGPAR  vector  (augmented  data  array  for  input  values) 

45  LUVN  -  VNORTH  file  (northern  hemisphere  electric  potential  distribution) 

46  LUVS  -  VSOUTH  file  (southern  hemisphere  electric  potential  distribution) 

47  LIONEG  -  Coefficients  to  calculate  ion  precipitating  energy  flux  in  default 
model 

48  LIONNO  -  Coefficients  to  calulate  ion  number  flux  in  default  model 

49  LUENCH  -  File  used  to  input  number  and  range  of  energy  channels  to  model 


Other  assignments  made: 
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IBEG 

ISTOP 

JBEG 

JSTOP 

lEBEG 


Starting  I  value,  currently  set  to  1 
Ending  I  value,  currently  set  to  53 
Starting  J  value,  currently  set  to  3 
Ending  J  value,  currently  set  to  50 
Starting  energy  value  index,  currently  set  to  1 
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EMODEL 

a.  Functions  -  This  subroutine  specifies  the  electric  potential  at  each  grid  point  in  the  modelling 
region  for  the  northern  hemisphere,  southern  hemisphere  and  the  average  of  both  hemispheres. 


b.  Inputs 


IPATT  Polar  cap  pattern  type  (from  Heppner-Maynard  empirical  model) 

PCP  Cross  polar  cap  potential  (Volts) 

DEQDT  Time  rate  of  change  of  the  latitude  of  the  equatorward  edge  of  the  auroral  zone 
at  midnight  (degrees/hour) 

A  Radius  of  ellipse  measured  in  X(sunward)  direction 

B  Radius  of  ellipse  measured  in  Y (duskward)  direction 

DX  Sunward  displacement  of  coordinate  system  center  from  pole 

DY  Duskward  displacement  of  coordinate  system  center  from  pole 

COLAT  Grid  colatitude  array  (radians) 

ALCXT  Grid  local  time  array  (radians  eastward  from  noon) 

MODE  Not  currendy  used 

LATDIM  Number  of  latitudinal  grid  lines 

LTDIM  Number  of  local  time  (longitude)  grid  hnes 

JWRAP  Number  of  points  of  overlap  in  J  (longitude)  direction 

ICNTRL  =  1  means  different  formulas  are  used  in  regions  1, 2, 3, 

=  2  means  Heppner-Maynard  formula  is  us^  for  all  latitudes ,  but  scaled  to 
externally  specified  cross  polar  cap  potential  drop  and  ellipse  parameters 
=  -1  means  Heppner-Maynard  formula  is  used  for  all  latitudes,  unsealed. 

=  -2  should  not  be  used.  It  is  the  form  used  by  the  Rice  Convection  Model 
ITOP  =  1  means  the  ellipse  parameters  A,  B,  DX,  and  DY  for  the  polar  cap  boundary 
are  computed  internally  in  the  subroutine.  This  is  the  normal  mode  for  the 
MSM. 


c.  Processing  -  following  is  a  list  of  the  subroutines  called  and  their  major  function: 

INPUT  Get  input  needed  for  computation  of  Heppner-Maynard  model 
THET  Function  that  gives  equation  for  the  electric  field  Iwundary  ellipse  in  flat  polar 
coordinates 

EPOT  Using  scaled  Heppner-Maynard  model  returns  potential  at  a  specific  point 
LOW  Returns  potential  at  a  specific  location  in  low  latitude  region 

AURORA  Returns  potential  at  a  specific  location  in  auroral  region 

REGl  Returns  potential  at  a  specific  location  in  Region  1 

A  concise  description  of  the  electric  field  model  and  its  components  is  given  in  Section  2.4  of  the 
Final  Report  for  Contract  #F19628-87-K-()()OL 
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d.  Output - 
V 


Electric  potential  disbritution  on  grid  (Volts) 
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EPOT 

a.  Functions  -  This  subroutine  uses  the  scaled  Heppner-Maynard  model  to  return  the  electric 
potential  at  a  specific  point. 


b.  Input - 

COEF 

TLAT 

TLON 

NTAPE 

IPATT 

NNMAX 

A 

B 

DX 

DY 

XCO 

.\HM 


BHM 

DXHM 

DYHM 

VMESf 

VMAX 

PCP 

ICNTRL 


Coefficients  from  digitization  of  Heppner-Maynard  electric  field  model 
Colatitude  of  point  on  boundary  to  be  calculated  (radians) 

Magnetic  loctd  time  of  point  on  boundary  to  be  cdculated  (radians) 

Unit  number  from  which  to  read  Heppner-Maynard  coefficients 
Heppner-Maynard  pattern  type 
Number  of  coefficients  to  use  in  calculation 
Radius  of  ellipse  measured  in  x  (sunward)  direction 
Radius  of  ellipse  measured  in  y  (duskward)  direction 
Radius  of  ellipse  measured  in  y  (duskward)  direction 
Radius  of  ellipse  measured  in  y  (duskward)  direction 
Electric  field  model  coefficients 

Radius  of  ellipse  measured  in  x  (sunward)  direction  from  Heppner-Maynard 
Model 

Radius  of  ellipse  measured  in  y  (duskward)  direction  from  Heppner-Maynard 
Model 

Radius  of  ellipse  measured  in  y  (duskward)  direction  from  Heppner-Maynard 
Model 

Radius  of  ellipse  measured  in  y  (duskward)  direction  from  Heppner-Maynard 
Model 

Computed  electric  potential  minimum  from  Heppner-Maynard  Model 
Computed  electric  potential  maximum  from  Heppner-Maynard  Model 
Cross-polar-cap  potential  drop 
=  1  means  different  formulas  are  used  in  regions  1, 2,  3, 

=  2  means  Heppner-Maynard  formula  is  us^  for  all  latitudes ,  but  scaled  to 
externally  specified  cross  polar  cap  potential  drop  and  ellipse  parameters 
=  -1  means  Heppner-Maynard  formula  is  used  for  all  latitudes,  unsealed. 

=  -2  should  not  be  used.  It  is  the  form  used  by  the  Rice  Convection  Model 


c.  Processing  -  A  concise  description  of  the  electric  field  model  and  its  components  is  given  in 
Section  2.4  of  the  Final  Report  for  Contract  #F19628-87-K-()()01. 

d.  Output  - 

VALUE  Electric  potential  at  point  on  boundary  a  (Volts) 
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LOW 


a.  Functions  -  This  subroutine  returns  the  electric  potential  at  a  specification  location  in  the  low 
latitude  region  of  the  electric  field  model. 


b.  Input - 


COL 

ALO 

DEQDT 

AEQEDG 

DXEQEG 

VBAR 

G 


Colatitude  of  point  on  boundary  to  be  calculated  (radians) 

Magnetic  local  time  of  point  on  boundary  to  be  calculated  (radians) 

Time  rate  of  change  of  equatorward  edge  of  auroral  zone  (degrees/hour) 

Radius  of  ellipse  3  measured  in  x  (sunward)  direction 

Offset  of  ellipse  3  in  x  direction 

Average  potential  at  low  latitudes 

Weighting  factor 


c.  Processing  -  A  concise  description  of  the  electric  field  model  and  its  components  is  given  in 
Section  2.4  of  the  Final  Report  for  Contact  #F 19628- 87 -K-OOOl. 


d.  Output - 
VLOW 


Electric  potential  of  a  point  in  low  latitude  region  (Volts) 
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AURORA 


a.  Functions  -  This  subroutine  returns  the  electric  potential  at  a  specific  location  in  the  auroral  zone 
region  of  the  electric  field  model. 


b.  Input  - 


COL  Colatitude  of  point  on  boundary  to  be  calculated  (radians) 

ALO  Magnetic  locd  time  of  point  on  boundary  to  be  calculated  (radians) 

VBAZ  Auroral-zone  contribution  to  the  potenti^  at  boundary  b 
TB  Location  of  boundary  b  for  specific  local  time 

TC  Location  of  boundary  c  for  specific  local  time 

J  Local  time  index 

JMAX  Maximum  number  of  points  in  J  direction 
JWRAP  Number  of  points  of  overlap  in  J  direction 


c.  Processing  -  A  concise  description  of  the  electric  field  model  and  its  components  is  given  in 
Section  2.4  of  the  Final  Repon  for  Contract  #F19628-87-K-0()01. 


d.  CXitput  - 


VAZ 


Electric  potential  for  a  point  in  the  auroral  zone  (Volts) 
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REGl 


a.  Functions  -  This  subroutine  returns  the  electric  potential  for  a  specific  point  in  Region  1  of  the 
electric  field  model. 


b.  Input  - 

COL  Colatitude  of  point  on  boundary  to  be  calculated  (radians) 

AL  Magnetic  loc^  time  of  point  on  boundary  to  be  calculated  (radians) 

TA  Location  of  boundary  a  for  specific  local  time 

TB  Location  of  boundary  b  for  specific  local  time 

VAA  Electric  potential  for  point  on  boundary  a 

VBB  Electric  potential  for  point  on  boundary  b 

DVAA  Derivative  of  electric  potential  for  point  on  boundary  a 

DVBB  Derivative  of  electric  potential  for  point  on  boundary  b 


c.  Processing  -  A  concise  description  of  the  electric  field  model  and  its  components  is  given  in 
Section  2.4  of  the  Final  Report  for  Contract  #F 19628- 87-K-OOOl. 


d.  Output  - 

VI  Electric  potential  for  a  point  in  Region  1  (Volts) 
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THET 

a.  Function  -  This  function  subprogram  gives  the  equation  for  an  electric  field  boundary  ellipse  in 
flat  polar  coordinates. 


b.  Input  - 

AA  Radius  of  ellipse  measured  in  X(sunward)  direction 

BB  Radius  of  ellipse  measured  in  Y(duskward)  direction 

XC  Sunward  displacement  of  coordinate  system  center  from  pole 

YC  Duskward  displacement  of  coordinate  system  center  from  pole 

PHI  Magnetic  local  time 


c.  Processing  -  This  function  gives  the  solution  to  the  equation  for  an  ellipse  in  flat  polar 
coordinates.  It  specifies  colatitude  as  a  function  of  local  time. 


d.  Output  - 

THET  Colatitude  of  input  ellipse  parameters  and  local  time 
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INPUT 


a.  Function  -  This  subroutine  reads  in  the  necessary  input  for  the  computation  of  the  Heppner- 
Maynard  electric  field  model. 


b.  Input - 

NTAPE  Unit  number  from  which  to  read  Heppner-Maynard  coefficients 


c.  Processing  -  This  subroutine  reads  from  logical  unit  NTAPE  the  coefficients  necessary  for  the 
Heppner-Maynard  electric  field  model. 


d.  Output - 

COEF 

IPATT 

XCO 

AHM 

BHM 

DXHM 

DYHM 

VMIN 

VMAX 


Coefficients  from  digitization  of  Heppner-Maynard  electric  field  model 
Polar  cap  pattern  type  (from  Heppner-Maynard  empirical  model) 

E  field  coefficients 

Radius  of  elhpse  measured  in  x  (sunward)  direction  from  Heppner-Maynard 
Model 

Radius  of  ellipse  measured  in  y  (duskward)  direction  from  Heppner-Maynard 
Model 

Radius  of  ellipse  measured  in  y  (duskward)  direction  fix)m  Heppner-Maynard 
Model 

Radius  of  ellipse  measured  in  y  (duskward)  direction  from  Heppner-Maynard 
Model 

Computed  electric  potential  minimum  from  Heppner-Maynard  Model 
Computed  electric  potential  maximum  ft-om  Heppner-Maynard  Model 
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BTRACE 

a.  Functions  -  Subroutine  to  calculate  magnetic  field  models  for  appropriate  geophysical  conditions 
as  specified  by  the  standoff  distance,  equatorward  edge  of  the  auroral  zone,  Dst,  tail  collapse 
parameter,  and  tilt  angle.  Calculates  the  output  on  the  MSM  spatial  grid  by  interpolating  l^tween 
pre-computed  magnetic  field  models. 


b.  Input - 

LATDIM  Number  of  latitudinal  grid  lines 

LTDIM  Number  of  local  time  fiongitude)  grid  lines 

riMDIM  Maximum  number  of  major  time  steps  per  run  of  the  program 

L  Current  temporal  grid  index 

FSTOFF  Standoff  distance  (Re) 

FEQEDG  Equatorward  edge  of  aurora  (degrees) 

FDST  Dst  (nT) 

FCLPSE  Collapse  parameter 

FTILT  Tilt  angle  (degrees) 

ALOCT  Local  time  hour  angle  (measured  east  from  noon) 

TETA  Colatitude  of  I  grid  lines  (radians) 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

GETMAT  Subroutine  to  find  the  magnetic  field  matrices  needed  for  interpolation  in  order 
to  represent  current  conditions 

RMVBSH  Subroutine  to  extrapolate  magnetic  field  matrices  into  extremely  s  retched  or 
open  regions 

BFGYRO  Subroutine  to  rotate  fixed  grid  magnetic  field  arrays  to  match  rotating  corrdinate 
system 

This  subroutine  determines  which  of  the  pre-computed  magnetic  field  matrices  are  needed  to 
match  the  geophysical  conditions  specified .  After  the  matrices  are  retrieved  and  stored  into  a  work 
array  (WORK(LATDIM,LTDIM,2,2,2,2,2)  they  are  interpolated  using  a  multilinear  interpolation 
scheme  given  by  Press  et  al.  in  Numerical  Recipes.  Cambridge  University  Press,  1987,  pp  95-97. 
The  arrays  arc  then  rotated  so  that  they  have  the  same  local  time  orientation  as  the  main  program. 


d.  Output - 

VM  Flux  tube  volume  ((Re/nT)-2/3) 

BMIN  Equatorial  magnetic  field  strengA  (nT) 

XMIN  GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 

YMIN  GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 


Pi  a, 
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ZMIN  GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the  equatorial 
(B-field  minimum)  plane  (Re) 

Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 
Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of  grid  pts 
in  equatorial  plane 
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BFGYRO 

a.  Functions  -  Subroutine  to  rotate  fixed  grid  magnetic  field  arrays  to  match  the  rotating  grid 
system  of  the  main  program. 


b.  Inputs  - 

LATDIM  Number  of  latitudinal  grid  lines 
LTDIM  Number  of  local  time  (longitude)  grid  lines 

ARRAY  Unrotated  magnetic  field  values  c^ed  sequentially  for  the  following  quantities; 
VM  -  Flux  tube  volume  ((Re/nT)-2/3) 

BMIN  -  Equatorial  magnetic  field  strength  (nT) 

XMIN  -  GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the 
equatorial  (B-field  minimum)  plane  (Re) 

YMIN  -  GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the 
equatorial  (B-field  minimum)  plane  (Re) 

ZMIN  -  GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the 
equatorial  (B-field  minimum)  plane  (Re) 

WORK  Internal  working  array 

ALOCT  Local  time  hour  angle  (measured  east  from  noon) 


c.  Processing  -  No  other  subroutines  are  called. 

This  routine  uses  a  linear  interpolation  scheme  to  determine  how  much  the  magnetic  field  matrices 
should  be  rotated  (F).  It  applies  this  factor  to  the  input  matrices  so  that  the  magnetic  local  time  of 
the  magnetic  field  matrices  and  the  main  program  agree. 


d.  Output - 

ARRAY  Rotated  magnetic  field  values  for  the  following  quantities: 

VM  -  Flux  tube  volume  ((Re/nT)'2/3) 

BMIN  -  Equatorial  magnetic  field  strength  (nT) 

XMIN  -  GSM  X  location  of  where  field  line  going  through  grid  pt  crosses  the 
equatorial  (B-field  minimum)  plane  (Re) 

YMIN  -  GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses  the 
equatorial  (B-field  minimum)  plane  (Re) 

ZMIN  -  GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses  the 
equatorial  (B-field  minimum)  plane  (Re) 
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PPTM 

a.  Functions  -  This  subroutine  traces  particle  trajectories  from  each  grid  point  for  each  particle 
species  back  in  time  from  time=TSTART  to  time=TSTOP. 


b.  Inputs 


TSTART 

TSTOP 

DTNOM 

SCTFRC 

EFLAV 


BNDMAX 

ALPHA 

BETA 

BIR 

ITMMAX 

IDIM 

JDIM 

lEDIM 

ITMDIM 

IRDIM 

NRGDIM 

KPDIM 

KPPLUS 

ISPDIM 

FLXR 

FLXNRG 

FLXKP 

FLXMAT 


THRMAT 


TIMTAG 

ALAM 

ALMDEL 

VM 

R 

P 


Time  at  which  to  begin  particle  traceback  (seconds) 

Time  at  which  to  end  particle  traceback  (seconds) 

Nominal  time  step  to  begin  traces.  DTNOM  <  0  to  trace  back  in  time.  PPTM 
will  adjust  time  step  as  needed 
Assumed  pitch  angle  scattering  efficiency 
Chemical  species  identifier 

1  means  electrons 

2  means  H"*"  ions 

3  means  O'*"  ions 

Maximum  I  value  of  model  boundary  along  each  local  time  grid  line  during  the 
duration  of  this  run. 

Latitundinal  grid  spacing  vector 

Longitudinal  grid  spacing  vector 

Radial  component  of  ionospheric  magnetic  field  (nT) 

Number  of  temporal  grid  points  used 
Number  of  latitudinal  grid  lines ) 

Number  of  local  time  fiongitude)  grid  lines 

Number  of  invariant  energy  species  traced  by  the  program 

Maximum  number  of  major  time  steps  per  run  of  Ae  program 

Number  of  R  values  for  which  the  empirical  flux  array,  FIJCMAT,  is  calculated 

Number  of  preset  energy  values  for  which  FLXMAT  is  calculated 

Number  of  KP  values  for  which  FLXMAT  is  calculated 

KP  dimension  of  augmented  FLXMAT  array  (KPPLUS=KPDIM+2) 

Number  of  plasma  mass  species  (electrons,  H'*',  etc.) 

R  values  at  which  FLXMAT  arrays  are  calculated  (Re) 

Energy  values  for  which  FLXMAT  arrays  are  calculated  (logio(eV)) 

KP  values  for  which  FLXMAT  arrays  are  calculated 

Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  in 

calculating  initial  and  boundary  flux  values  (log]o(#/cm2-s-ster-eV)) 

Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  as  threshold 
fluxes.  (logio(#/cm2-s-ster-eV)) 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated 
Energy  invariant  vector  (eV(Re/nT)^) 

Width  of  energy  invariant  channels 
Flux  tube  volume  ((Re/nT)'2^) 

Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 
Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of  grid  pts 
in  equatorial  plane 
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VMLOSS  Geometric  factor  used  in  calculating  precipitation  loss 


V 

ETABEG 

ETABND 

BNDLOC 

LL 

RPP 

FKP 

lEMAX 

THRSH 

TSHENG 

TSHING 

IRDK 

INRGDK 

ISOLDK 

lONDK 

DKTIME 


Electric  potential  distribution  on  grid  (Volts) 

Initial  flux  tube  content  distribution  each  time  step  (weber^) 

Boundary  flux  tube  content  distribution  (weber^) 

Location  of  outer  boundary  of  detailed  particle  traces 
Current  temjwral  grid  index 

Nominal  radius  of  plasmapause  defined  as  dipole  mapping  of  equatorward  edge 
of  auroral  zone  to  magnetospheric  equatorial  plane  (Re) 

Current  Kp  value 

Number  of  energy  channels  in  use 

Vector  giving  fidl-traceback/default  flux  information 

Threshold  value  to  switch  from  full-traceback  to  default  models  -  current  set  at 
>100  keV  electrons 

Threshold  value  to  switch  to  default  models  for  ions  -  currently  set  at  50  keV 

R  dimension  of  DKTIME  array 

Energy  dimension  of  DKTINffi  array 

Sun  spot  number  dimension  of  DKTIME  array 

Number  of  ion  species  in  DKTIME  array 

Array  giving  charge  exchange  decay  times  (seconds)  for  an  array  of  radial 
distances,  energies,  sunspot  numbers,,  and  species 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  function 


SETREF 

OUTP 

TNORML 

G3NTRP 

WKRATE 

MOVER 

MODFDC 

TCHK 

BNDCHK 

FLXVAL 


Subroutine  to  set  upper  limit  reference  flux 

Utility  routine  to  print  our  array  information 

Utility  function  subprogram  to  calculate  run-normalized  time 

Utility  function  subprogram  to  perform  a  general  3-d  linear  interpolation  of  an 

arbitr^  array  A(I,J,K)  at  point  (BI,BJ,BK) 

Function  subprogram  to  evaluate  weak  precipitation  loss  rate 

Subroutine  to  advance  one  particle  location  one  time  step  using  4th-order 

Runge-Kutta  algorithm  with  5th  order  correction 

Subroutine  to  adjust  BBJ  to  be  between  2  and  JDIM-1 

Subroutine  to  check  whether  time  boundary  was  crossed 

Subroutine  to  determine  whether  particle  has  crossed  boundary  of  calculation 

Function  subprogram  to  calculate  Kp-dependent  flux  value  a  R=RR  for  particles 

of  energy  ENRG  and  Kp=FKP  by  interpolating  FLXMAT  array 


See  the  following  flow  chart  for  the  logic  of  the  subroutine. 


d.  Output 


ETA 


Flux  tube  content  array  (weber^) 
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EFLUX  Precipitation  energy  flux  array  (ergs/cm^-sec) 

FLXSUM  Total  precipitation  energy  flux  array  (integrated  over  species  for  (1)  electrons 
(2)  and  (3)  0+)  (ergs/cm^-sec) 

Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H"*"  and  (3)  0‘‘‘(eV) 


EAVG 
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BNDCHK 

a.  Functions  -  This  subroutine  determines  whether  a  particle  has  crossed  the  spatial  boundary  of 
the  model  calculation. 


b.  Input - 


T 

IE 

BBI 

BBJ 

BIOLD 

BJOLD 

TIMTAG 

ETABND 

BNDMAX 

BNDLOC 

JDIM 

lEDIM 

ITMDIM 

ITMMAX 

JWRAP 


Time 

Energy  channel 
I  location  at  end  of  time  step 
J  location  at  end  of  time  step 
I  location  at  beginning  of  time  step 
J  location  at  beginning  of  time  step 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated  (seconds) 
Boundary  flux  tube  content  distribution  (weber^) 

Maximum  I  value  of  model  boundary  along  each  local  time  grid  line  during  the 
duration  of  this  run. 

Location  of  outer  boundary  of  detailed  particle  traces 

Number  of  local  time  (longitude)  grid  lines 

Number  of  invariant  energy  species  traced  by  the  program 

Maximum  number  of  major  time  steps  per  run  of  the  program 

Number  of  temporal  grid  points  used 

Number  of  points  of  overlap  in  J  direction 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  function: 

TNORML  Utility  function  subprogram  to  calculate  run-normalized  time 

Using  BNDMAX,  the  I  value  of  the  boundary,  the  time-normalized  I  (BBI)  and  J  (BBJ)  input 
values  are  compared  to  see  if  the  particle  has  passed  out  of  the  outer  boundary  of  the  calculation 
region.  If  the  particle  has  passed  the  boundary,  the  ETA  value  at  that  point  on  the  boundary  is 
calculated  and  returned. 


d.  Output - 

ETANIL  If  boundary  is  crossed,  ETANIL  is  the  value  of  ETA  at  the  boundary  crossing 

point  (weberO 

EXIT  If  the  boundary  is  crossed,  EXIT  =  2 
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DVEFDI 


a.  Function  -  Function  subprogram  to  compute  the  I  derivative  of  the  effective  potential  at  grid 
point  (I,J)  at  normalized  time  BT. 


b.  Input  - 

I  I  coordinate  of  the  grid  point 

J  J  coordinate  of  the  grid  point 

BT  Normalized  time 

AALAM  Energy  invariant  vector  (eV (Re/nT)^^) 

V  Electric  potential  distribution  on  grid  (Volts) 

VM  Flux  tube  volume  ((Re/nT)-2/3) 

IDIM  Number  of  latitudin^  grid  lines ) 

JDIM  Number  of  local  time  (longitude)  grid  lines 

ITMDIM  Maximum  number  of  major  time  steps  per  run  of  the  program 


c.  Processing  -  No  other  subroutines  are  called. 

Standard  central-difference  formula  is  used  to  differentiate  the  effective  potential  (potential  energy  - 
kinetic  energy)  in  the  I  direction. 


d.  Output - 

DVEFDI  Derivative  of  effective  potential  at  point  (I  J,BT) 


MAINTENANCE  MANUAL  -  30 


DVEFDJ 


a.  Function  -  Function  subprogram  to  compute  the  J  derivative  of  the  effective  potential  at  grid 
point  (I,J)  at  normalized  time  BT. 


b.  Input  - 

I  I  coordinate  of  the  grid  point 

J  J  coordinate  of  the  grid  point 

BT  Normalized  time 

AALAM  Energy  invariant  vector  (eV(Re/nT)2ri) 

V  Electric  potential  distribution  on  grid  ^olts) 

VM  Rux  tube  volume  ((Re/nT)‘2ri) 

IDIM  Number  of  latitudinal  grid  tines ) 

JDIM  Number  of  local  time  (longitude)  grid  tines 

ITMDIM  Maximum  number  of  major  time  steps  per  run  of  the  program 


c.  Processing  -  No  other  subroutines  are  called. 

Standard  central-difference  formula  is  used  to  differentiate  the  effective  potential  (potential  energy  - 
kinetic  energy)  in  the  J  direction. 


d.  Output - 

DVEFDJ  Derivative  of  effective  potential  at  point  (I,J,BT) 
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G3NTRP 


a.  Functions  -  Utility  function  subprogram  to  perform  a  general  3-d  linear  interpolation  of  an 
arbitrary  array  A(I,J,K)  at  point  (BI,BJ,BK) 


b.  Input - 

A  Array  to  be  interpolated 

IMAX  I  dimension  of  array  A 

JMAX  J  dimension  of  array  A 

KMAX  K  dimension  of  array  A 

BI  Floating  point  value  to  interpolate  in  I  dimension 

B  J  Floating  point  value  to  interpolate  in  J  dimension 

BK  Floating  point  value  to  interpolate  in  K  dimension 


c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  uses  the  standard  linear  interpolation  technique  to  interpolate  an  array  in  3 
dimensions. 


d.  Output - 

G3NTRP  Interpolated  point  from  array  A 


MODFK 


MAINTENANCE  MANUAL  -  32 


a.  Functions  -  Subroutine  to  adjust  J  value  to  be  within  array  bounds. 

b.  Input - 

BBJ  J  value  to  be  adjusted 

JDIM  J  dimension  of  array 

JWRAP  Number  of  points  of  overlap  in  J  direction 

c.  Processing  -  No  other  subroutines  are  called. 

The  subroutine  tests  to  see  if  the  value  is  within  the  array  bounds  and  adjusts  the  value  if  it  is  not. 


d.  Output - 


BBJ 


Adjusted  J  value 


MOVER 
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a.  Functions  -  Subroutine  to  advance  one  particle  location  one  time  step  using  4th-order  Runge- 
Kutta  algorithm  with  5th  order  coirection. 


b.  Input - 

T  Tune  parameter 

DTTRY  Time  step  to  try 

<  0  =  moves  particles  back  in  time 
>  0  =  moves  particles  forward  in  time 
BIOLD  Current  I  location  of  particle 

BJOLD  Current  J  location  of  particle 

EPS  Accuracy  parameter 

BBISCL  I  error  scaling  parameter 
BBJSCL  J  error  scaling  parameter 

AALAM  Energy  invariant  vector  (eV(Re/nT)2/3) 

V  Electric  potential  distribution  on  grid  (Volts) 

VM  Flux  tube  volume  ((Re/nT)-^) 

TIMTAG  Vector  giving  times  at  which  E  and  B  parameters  are  calculated  (seconds) 

ALPHA  Latitundinal  grid  spacing  vector 

BETA  Longitudinal  grid  spacing  vector 

BIR  Radial  component  of  ionospheric  magnetic  field  (nT) 

IDIM  Number  of  latitudinal  grid  lines ) 

JDIM  Number  of  local  time  (longitude)  grid  lines 

ITMDIM  Maximum  number  of  major  time  steps  per  run  of  the  program 

c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

RK4  4th  order  Runge-Kutta  routine 


This  routine  is  based  on  the  discussion  in  Numeric^  Recipes.  Press  et  al,  on  pages  550-560  in  the 
chapter  on  integration  of  ordinary  differential  equations. 


d.  Output - 

BBI  Updated  I  location  of  particle 

BBJ  Updated  J  location  of  particle 

DTUSED  Time  step  actually  used 

DTNEXT  Estimated  next  stepsize 


RK4 
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a.  Functions  -  This  subroutine  integrates  an  ordinary  differential  equation  using  a  4th  order 
Runge-Kutta  scheme. 


b.  Inputs  - 


T 

DT 


BBIIN 

BBJIN 

AALAM 

V 

VM 

TIMTAG 

ALPHA 

BETA 

BIR 

IDIM 

JDIM 

ITMDIM 


Time  parameter 
Time  step 

<  0  =  moves  particles  back  in  time 
>  0  =  moves  particles  forward  in  time 
Current  I  location  of  particle 
Current  J  location  of  particle 
Energy  invariant  vector  (eV(Re/nT)2/3) 

Electric  potential  distribution  on  grid  (Volts) 

Flux  tube  volume  ((Re/nT)'^) 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated  (seconds) 

Latitundinal  grid  spacing  vector 

Longitudinal  grid  spacing  vector 

Radial  component  of  ionospheric  magnetic  field  (nT) 

Number  of  latitudinal  grid  lines 

Number  of  local  time  (longitude)  grid  lines 

Maximum  number  of  major  time  steps  per  run  of  the  program 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  function: 


VLOCTY  Subroutine  to  compute  I  and  J  components  of  particle  velocity  with  energy 
invariant  AALAM  at  location  (BLBJ)  at  normahzed  time  BT 


This  algorithm  comes  from  Abramowitz,  Milton  and  Stegun,  Irene  A.,  1964,  Handbook  of 
Mathematical  Function.  National  Bureau  of  Standards,  1970,  p.  896,  section  25.5.10.  It  is  also 
referenced  in  Numerical  Recipes  by  Press  et  al. 


d.  Output 

BBIOUT  Computed  I  location  at  end  of  time  step 
BBJOUT  Computed  J  location  at  end  of  time  step 


TCHK 
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a.  Functions  -  This  subroutine  checks  whether  a  particle  has  crossed  a  time  boundary  for  this  time 
step 


b.  Input - 

T  Time 

TSTOP  Time  at  which  to  end  particle  traceback 
DTNOM  Nominal  time  step  to  begin  traces 

BBI  I  location  of  particle 

BBJ  J  location  of  particle 

lEUSE  Energy  index  of  particle 

ETABEG  Initial  flux  tube  content  distribution  each  time  step  (weber^) 

IDIM  Number  of  latitudinal  grid  lines 

JDIM  Number  of  local  time  (longitude)  grid  lines 

lEDIM  Number  of  invariant  energy  species  traced  by  the  program 


c.  Processing  -  following  are  the  subroutines  called  and  major  functions: 

G3NTRP  Utility  function  subprogram  to  perform  a  general  3-d  linear  interpolation  of  an 
arbitrary  array  A(I,J,K)  at  point  (BI,BJ,BK) 

If  time  boundary  is  crossed,  the  ETA  at  the  location  (BBI, BBJ)  is  interpolated. 


d.  Output - 

ETANIL  ETABEG  value  at  location  (BBI,BBJ)  at  time  T  for  energy  species  lEUSE  if 
particle  has  crossed  time  boundary  (weber^) 

=  1  if  particle  has  crossed  time  boundary 


lEXIT 


TNORML 
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a.  Functions  -  Utility  function  subprogram  to  calculate  run-normalized  time. 


b.  Input - 

TT  Time  (seconds) 

TIMTAG  Vector  giving  times  at  which  E  and  B  parameters  are  calculated  (seconds) 
ITMMAX  Number  of  temporal  grid  points  used 


c.  Processing  -  No  other  subroutines  are  called. 

Using  the  run  times  given  in  TIMTAG,  the  time  is  located.  Using  standard  linear  interpolation,  the 
correction  factor  is  cdculated. 


d.  Output - 


TNORML  Non-integer  time  index  corresponding  to  time  TT 


VLOCTY 
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a.  Functions  -  This  subroutine  computes  the  I  and  J  components  of  particle  velocity  for  a  particle 
with  energy  invariant  AALAM  at  location  at  normalized  time  BT. 


b.  Input - 

BBH 

I  location  of  particle 

BBJJ 

J  location  of  particle 

BT 

Normalized  time 

AALAM 

Energy  invariant  vector  (eV(Re/nT)2/3) 

ALPHA 

Latitundinal  grid  spacing  vector 

BETA 

Longitudinal  grid  spacing  vector 

BIR 

Radial  component  of  ionospheric  magnetic  field  (nT) 

V 

Electric  potential  distribution  on  grid  (Volts) 

VM 

Flux  tube  volume  ((Re/nT)'2/3) 

IDIM 

Number  of  latitudind  grid  tines 

JDIM 

Number  of  local  time  (longitude)  grid  tines 

ITMDIM 

Maximum  number  of  major  time  steps  per  run  of  the  program 

c.  Processing  -  following  are  the  subroutines  called  and  major  functions: 

G3NTRP  Utility  function  subprogram  to  perform  a  general  3-d  linear  interpolation  of  an 
arbitrary  array  A(I,J,K)  at  point  (BI,BJ.BK) 

This  subroutine  computes  the  I  and  J  components  of  the  particle’s  ExB  drift. 


d.  Output - 

DBIDT  I  velocity  of  particle  (I  units/sec) 
DBJDT  J  velocity  of  panicle  (J  units/sec) 


RDGRID 
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a.  Functions  -  Subroutine  to  read  grid  system  coordinates  and  calculate  essential  grid  quantities. 


b.  Input  -  Read  from  input  file  'COORD' 

ID  Eight  character  identifier 

OFFSET  Offset  of  center  of  coordinate  system  from  magnetic  pole,  cuirently  zero 

DLAM  Latitudinal  grid  spacing  constant 

DPSI  Local  time  grid  spacing  constant 

RI  Radius  of  earth  +  ionosphere  (km) 

RE  Radius  of  earth  (km) 

ALPHA  Latitundinal  grid  spacing  vector 

BETA  Longitudinal  grid  spacing  vector 

TETA  Colatitude  of  I  grid  lines  (radians) 

PHI  Non-rotated  hour  angle  of  J  grid  lines  (radians) 


c.  Processing  -  No  other  subroutine  are  called. 


d.  Additional  outputs - 

BIR  Radial  component  of  ionospheric  magnetic  field  (nT) 

SINI  SIN(Magnetic  field  inclination  angle) 

COLAT  Grid  colatitude  array  (radians) 


MLTSET 
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a.  Functions  -  This  subroutine  calculates  the  time  dependent  magnetic  local  time  of  rotating  grid 
points. 


b.  Input - 

ISEC  Time  from  start  of  run  (seconds) 

IDIM  Number  of  latitudinal  grid  lines ) 

JDIM  Number  of  local  time  (longitude)  grid  lines 

c.  Processing  -  No  other  subroutines  are  called. 

The  subroutine  calculates  the  change  in  the  hour  angle  of  the  J  grid  lines  (DPHI)  and  the  time  rate 
of  change  of  the  hour  angle  of  the  J  grid  lines  (DPHIDT)  to  compute  the  time  dependent  magnetic 
local  time  grid 


d.  Output - 

ALOCT  Time  dependent  magnetic  local  time  grid 


VMLSET 
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a.  Functions  -  This  subroutine  sets  up  the  time-dependent  VMLOSS  array 


b.  Input - 

FTMCUR  Current  time  label 
VM  Flux  tube  volume  ((Re/nT)-2/3) 

BIR  Radial  component  of  ionospheric  magnetic  field  (nT) 

SINI  SIN(Magnetic  field  inclination  angle) 

IDIM  Number  of  latitudinal  grid  lines ) 

JDIM  Number  of  local  time  (longitude)  grid  lines 

riMDIM  Maximum  number  of  major  time  steps  per  run  of  the  program 


c.  Processing  -  No  other  subroutines  are  called. 


d.  Ouput- 

VMLOSS  Geometric  factor  used  in  calculating  precipitation  loss 
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FNDBND 


_  Functions  -  This  subroutine  computes  the  time  dependent  outer  model  boundar>'  locution. 


b.  Input - 

ITMCUR  Current  time  label 
COLAT  Grid  colatitude  array  (radians) 

ALOCT  Time  dependent  magnetic  local  time  grid  (radians  eastward  from  noon) 
A2  Radius  of  ellipse  2  measured  in  x  (sunward)  direction 

B2  Radius  of  ellipse  2  measured  in  y  (duskward)  direction 

DX2  Offset  of  ellipse  2  measured  in  y  (duskward)  direction 

DY2  Offset  of  ellipse  2  measured  in  y  (duskward)  direction 

EDIM  Number  of  latitudinal  grid  lines ) 

JDIM  Number  of  local  time  (longitude)  grid  lines 

ITMDIM  Maximum  number  of  major  time  steps  per  run  of  the  program 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  function: 

THET  Function  that  gives  the  equation  for  an  electric  field  boundary  ellipse  in  flat 
polar  coordinates 

For  each  J  (longitudinal)  value,  the  location  of  the  outer  boundary  is  calculated.  Then  the 
colatitude  array  (COLAT)  is  searched  to  find  the  pair  of  I  values  that  encompass  the  boundary.  The 
location  is  then  linearly  interpolated  and  placed  in  the  array  BNDLOC. 


d.  Output - 

BNDLCX!  Location  of  outer  boundary  of  detailed  particle  traces 


OUTP 
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a.  Functions  -  This  is  utility  subroutine  to  print  out  array  information. 


b.  Input - 

R  Array  to  be  output 

ISIZE  I  dimension  of  R  anray 

JSIZE  J  dimension  of  R  array 

IBEG  Initial  I  value  to  be  output 
lEND  Final  I  value  to  be  output 
IINC  I  value  increment  for  output 

JBEG  Initial  J  value  to  be  output 
JEND  Final  J  value  to  be  output 
JINC  J  value  increment  for  output 

XSCALE  =  0.0  scale  is  calculated  by  subroutine  to  give  best  display.  All  elements  or 
array  are  divided  by  scale  before  being  output 

^  0.0  scale  is  set  by  user 

TITLE  Character  string  that  identifies  the  array  being  output 
NTP  Output  unit  number 

NCOL  Number  of  columns  of  output  device  (usually  either  80  or  132) 


c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  takes  any  2-dimensional  array  and  formats  the  output. 


d.  Output  -  The  array  is  output  to  the  device  NTP. 


AURLl  (also  FNDHDY,  ADDHDY,  FSUM) 
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a.  Fvnction  -  These  subroutines  determine  the  default  Hardy  precipitating  electron  flux. 


b.  Input - 

FKP  C^uirent  Kp  value 

COLAT  Grid  colatitude  array  (radians) 

ALOCT  Time  dependent  magnetic  local  time  grid  (radians) 
LATDIM  Number  of  latitudinal  grid  lines ) 

LTDIM  Number  of  local  time  (longitude)  grid  lines 


c.  Processing  -  following  are  the  subprograms  called  and  their  major  function: 

F’NDHDY  Subroutine  to  find  and  read  the  pertinent  Fourier  coefficients  fot  the  Hardy 
electron  model 

ADDHDY  Subroutine  to  calculate  the  Hardy  model  electron  flux  value  for  a  given  point 
FSUM  Function  subprogram  to  determine  sum  of  a  Fourier  series 

These  subroutines  were  supplied  by  Dr.  David  Hardy  at  the  Air  Force  Geophysics  Laboratory, 
Bedford,  Mass. 


d.  Output - 

AEFLUX  The  integral  electron  energy  flux  (ergs/cm^-sec) 
AEMEAN  The  average  energy  (eV) 


WRT3D 
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a.  Functions  -  This  subroutine  writes  3-d  arravs  to  disk  in  the  standard  MSM  disk  file  format. 


b.  Input  - 

LUN  Logical  unit  number  on  which  to  write  file 
IRECMX  Logical  record  number  at  which  to  write  data 
ID  Integer  header  vector 

ID(1)  =  Year 
ID(2)  =  Day 
ID(3)  =  Hours 
ID(4)  =  Minutes 
ID(5)  =  Seconds 
ID(6)  =  Presently  unused 
ID(7)  =  Presently  unused 
ID(8)  =  First  dimension  of  output  array 
ID(9)  =  Second  dimension  of  output  array 
ID(IO)  =  Tliird  dimension  of  output  array 
ID(1 1)  =  Time  index  L 
ID(12)  -  ID(20)  =  Presently  unused 
RID  Real  header  vector 

RID(l)  =  TIMTAG  (seconds) 

RID(2)  =  KP 

RID(3)  =  Polar  cap  potential  drop  (kV) 

RID(4)  =  Time  derivative  of  location  of  low-latitude  edge  of  auroral 
precipitatioti  (degrees/hour) 

RID(5)  -  RID(20)  =  I^sently  unused 

CHID  Character  header  string  (up  to  80  characters) 

ARRAY  3-d  array  to  be  written 

IDIM  I  dimension  of  ARRAY 

JDIM  J  dimension  of  ARRAY 

KDIM  K  dimension  of  ARRAY 

ITMDIM  Maximum  number  of  major  time  steps  for  this  run 


c.  Processing  -  No  other  subroutines  are  called. 

This  routine  takes  the  desired  array,  opens  the  appropriate  file,  writes  the  array  to  the  file  starting 
with  the  specified  logical  record  number,  and  closes  the  file. 


d.  Output  -  The  array  is  written  to  unit  number  LUN. 
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RDHDR 


a.  Functions  -  This  subroutine  reads  the  header  record  of  the  standard  MSM  disk  file 


b.  Input - 

LUN  Logical  unit  number  on  which  to  write  file 

FILNAM  Character  string  containing  file  name 
IRECMX  Record  number  to  begin  read  function 

IDIM  I  dimension 

JDIM  J  dimension 

ITMDIM  Maximum  number  of  major  time  steps  for  this  run 


c.  Processing  -  No  other  subroutines  are  called. 

This  routine  opens  the  appropriate  file,  reads  the  header  information  of  the  file  starting  with  the 
specified  record  number,  and  closes  the  file. 

d.  Output - 

ID  Integer  header  vector 

ID(1)  =  Year 
ID(2)  =  Day 
ID(3)  =  Hours 
ID(4)  =  Minutes 
ID(5)  =  Seconds 
ID(6)  =  Presently  unused 
ID(7)  =  Presently  unused 
ID(8)  =  First  dimension  of  output  array 
ID(9)  =  Second  dimension  of  output  array 
ID(IO)  =  Third  dimension  of  output  array 
ID(1 1)  =  Time  index  L 
ID(12)  -  ID(20)  =  Presently  unused 
RID  Real  header  vector 

RID(l)  =  TIMTAG  (seconds) 

RID(2)  =  KP 

RID(3)  =  Polar  cap  potential  drop  (kV) 

RID(4)  =  Time  derivative  of  location  of  low-latitude  edge  of  auroral 
precipitation  (degrees/hour) 

RID(5)  -  RID(20)  =  Presently  unused 
CHID  Character  header  string  (up  to  80  characters) 


READ3D 
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a.  Function  -  I  ttis  subroutine  reads  a  record  from  the  standard  MSM  disk  file. 


b.  Input - 


LUN 

FILNAM 

LREC 

DDIM 

JDIM 

KDIM 

ITMDIM 


Logical  unit  number  from  which  to  read  file 

Character  string  containing  file  name 

Logical  record  number  to  read  direct  access  data  set 

1st  dimension  of  ARRAY 

2nd  dimension  of  ARRAY 

3rd  dimension  of  ARRAY 

Maximum  number  of  major  time  steps  for  this  run 


c.  Processing  -  No  other  subroutines  are  called. 

This  routine  opens  the  appropriate  file,  reads  the  array  from  the  file  starting  with  the  specified 
record  number,  and  closes  the  file. 


d.  Output - 

ID  Integer  header  vector 

ID(1)  =  Year 
ID(2)  =  Day 
ID(3)  =  Hours 
ID(4)  =  Minutes 
ID(5)  =  Seconds 
ID(6)  =  Presently  unused 
ID(7)  =  Presently  unused 
ID(8)  =  First  dimension  of  output  array 
ID(9)  =  Second  dimension  of  output  array 
ID(1())  =  Third  dimension  of  output  array 
ID(1 1)  =  Time  index  L 
ID(12)  -  ID(20)  =  Presently  unused 
RID  Real  header  vector 

RID(l)  =  TIMTAG  (seconds) 

RID(2)  =  KP 

RID(3)  =  Polar  cap  potential  drop  (kV) 

RID(4)  =  Time  derivative  of  location  of  low-latitude  edge  of  auroral 
precipitation  (degrees/hour) 

RID(5)  -  RID(20)  =  Presently  unused 
CHID  Character  header  string  (up  to  80  characters) 


ARRAY  3-d  array  to  be  read 


SETALM 
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a.  Functions  -  This  subroutine  reads  the  number  of  energy  channels  and  their  energies  at 
geosynchronous  orbit  and  calculates  the  energy  invariant  species  corresponding  to  theses  energies. 

b.  Input  -  Read  from  file  ’ENCHAN’ 

IFLAV  Chemical  species  identifier 

1  means  electrons 

2  means  H+  ions 

3  means  0+  ions 

ENCHNL  Energy  channel  at  geosynchronous  orbit  (eV) 


c.  Processing  -  No  other  subroutines  are  called. 

The  input  data  must  be  in  eV  with  energy  increasing  within  each  chemical  species.  The  parameter 
VM6  is  the  typical  value  for  (flux  tube  volume)'^  at  geosynchronous  orbit. 


d.  Output- 


ALAM 

Energy  invariant  vector  (eV(Re/nT)2/3 

EMAX 

Maximum  number  of  energy  channels 

BEDIM 

Number  of  invariant  energy  species  traced  by  the  program 

IFLAV 

Chemical  species  identifier 

1  means  electrons 

2  means  H+  ions 

3  means  0"^  ions 

ALMDEL 

Width  of  energy  invariant  channels 

BNDSET 
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a.  Functions  -  This  subroutine  computes  the  boundary  plasma  distribution. 


b.  input - 


LATDIM 

LTDIM 

lEDM 

ITMDIM 

ITMMAX 

IRDIM 

NRGDIM 

KPDIM 

KPPLUS 

ISPDIM 

FLXR 

FLXNRG 

FLXKP 

FLXMAT 


NAUGEL 

TIMTAG 

BNDLOC 

IFLAV 


AUGPAR 

R 

P 


VM 

ETA 

ALAM 

ALMDEL 

lEMAX 


Number  of  latitundinal  grid  spaces 
Number  of  local  time  (longitundinal)  grid  spaces 
Number  of  particle  species  to  be  traced 
Maximum  number  of  major  time  steps  for  this  run 
Actual  number  of  time  steps  for  this  run 
R  dimension  of  FLXMAT  arrays 
Energy  dimension  of  FLXMAT  arrays 
KP  dimension  of  FLXMAT  arrays 
Augmented  KP  dimension  (=KPDIM+2) 

Plasma  mass  species  dimension 
R  values  at  which  FLXMAT  arrays  are  calculated  (Re) 

Energy  values  for  which  FLXMAT  arrays  are  calculated  (logio(eV)) 

KP  values  for  which  FLXMAT  arrays  are  calculated 

Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  in 

calculating  initial  and  boundary  flux  values  (logjoCWcm^-s-ster-eV)) 

Number  of  elements  in  the  augmented  input  array 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated  (seconds) 

Location  of  outer  boundary  of  detailed  particle  traces 

Chemical  species  identifier 

1  means  electrons 

2  means  H'*'  ions 

3  means  O'*"  ions 

Augmented  data  array  for  input  values 

Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 
Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of  grid  pts 
in  equatorial  plane 

(Flux  tube  volume)'2/3  ((Re/nT)'2/3) 

Flux  tube  content  array  (weber^) 

Energy  invariant  vector  (eV(Re/nT)2/3 
Width  of  energy  invariant  channels 
Maximum  number  of  energy  channels 


c.  Processing  -  No  other  subroutines  are  called. 

The  background  for  this  subroutine  is  contained  in  Section  2.5.5  of  Contract  #F19628-87-0001 
Final  Report. 


d.  Output 
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ETABND  Boundary  flux  tube  content  distribution  (weber^) 

FLXBND  Flux  values  at  boundary  (cm^  sec)'* 


SETSCT 
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a.  Functions  -  Subroutine  to  set  species-dependent  pitch  angle  scattering  efficiency. 


b.  Input  - 


L 

ISEC 

lEDIM 

LTDIM 

ITMDIM 

LATDIM 

FKP 

ALAM 

ALOCT 

lEMAX 


Time  label 
Time  (seconds) 

Number  of  particle  species  to  be  traced 

Number  of  local  time  (longitundinal)  grid  spaces 

Maximum  number  of  major  time  steps  for  this  run 

Number  of  latitundinal  grid  spaces 

Kp  value  for  current  time 

Energy  invariant  vector  (eV(R^nT)2/3 

Grid  local  time  array  (ra^ans  eastward  from  noon) 

Maximum  number  of  energy  channels 


c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  sets  the  species-dependent  pitch  angle  scattering  efficiency.  The  rationale  for  this 
subroutine  is  discussed  in  Section  2.6.3  of  the  Final  Report  for  Contract  #F19628-87-K-0001. 


d.  Output - 


SCTFRC  Assumed  pitch  angle  scattering  efficiency 


PFIX 
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a.  Functions  -  This  subroutine  adjusts  the  modulus  of  a  periodic  J  coordinate. 


b.  Input - 

P 1  Hour  angle  measured  eastward  from  noon  (radians) 

P2  Hour  angle  array  at  position  J  (radians) 

P3  Hour  angle  array  at  position  J+1  (radians) 

c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  adjusts  the  modulus  of  the  periodic  input  parameters  to  match  PI  so  that  they  can 
be  used  to  interpolate  dat 


d.  Output - 

P4  Adjusted  hour  angle  array  at  position  J  (radians)  (corresponds  to  P2) 

P5  Adjusted  hour  angle  array  at  position  J+1  (radians)  (corresponds  to  P3) 


INTTAL 
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a.  Functions  -  This  subroutine  computes  the  initial  plasma  distribution. 


b.  Input - 


LL 

LATDIM 

LTDIM 

lEDIM 

ITMDIM 

IRDIM 

NRGDIM 

KPDIM 

ISPDIM 

FLXR 

FLXNRG 

FLXKP 

FLXMAT 


BNDLOC 

IFLAV 


R 

P 

VM 

ETA 

ALAM 

ALMDEL 

FKP 

lEMAX 

A2ERO 

BZERO 

CZERO 


Time  label 

Number  of  latitundinal  grid  spaces 

Number  of  local  time  (longitundinal)  grid  spaces 

Number  of  particle  species  to  be  traced 

Maximum  number  of  major  time  steps  for  this  run 

R  dimension  of  FLXMAT  arrays 

Energy  dimension  of  FLXMAT  arrays 

KP  dimension  of  FLXMAT  arrays 

Plasma  mass  species  dimension 

R  values  at  which  FLXMAT  arrays  are  calculated  (Re) 

Energy  values  for  which  FLXMAT  arrays  are  calculated  (logio(eV)) 

KP  values  for  which  FLXMAT  arrays  are  calculated 

Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  in 

calculating  initial  and  boundary  flux  values  (logio(#/cm2-s-ster-eV)) 

Location  of  outer  boundary  of  detailed  particle  traces 
Chemical  species  identifier 

1  means  electrons 

2  means  H"*"  ions 

3  means  ions 

Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 
Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of  grid  pts 
in  equatorial  plane 

(Flux  tube  volume)'2/3  ((Re/nT)-2/3) 

Flux  tube  content  array  (weber^) 

Energy  invariant  vector  (eV(R^nT)2/3 
WidA  of  energy  invariant  channels 
Kp  at  present  time  step 
Maximum  number  of  energy  channels 
Statistical  model  weighting  parameter 
Old  results  weighting  parameter 
Traceback  weighting  paramater 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

FLXVAL  Function  subprogram  to  calculate  Kp-dependent  flux  value  a  R=RR  for  particles 
of  energy  ENRG  and  Kp=FKP  by  interpolating  FLXMAT  array 

This  subroutine  can  compute  the  initial  plasma  distribution  based  on  a  combination  of  empirical 
(Kp-based)  data  and  results  from  prefious  runs.  In  practice,  previous  run  results  are  used,  if 


MAINTENANCE  MANUAL  -  53 

available,  and  the  empirical  model  is  used  otherwise.  The  rationale  for  this  subroutine  is  discussed 
in  Section  2.5.4  of  the  Final  Report  for  Contract  #F19628-87-K-0001. 


d.  Output - 

ETABEG  Initial  flux  tube  content  distribution  each  time  step  (weber^) 


TIMINC 
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a.  Function  -  This  subroutine  increments  the  time  for  the  next  electric  and  magnetic  field  record. 

b.  Input - 

mME  Current  time  (year,  day,  seconds) 

IINC  Increment  time  (year, day, seconds) 

c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  increments  the  time  and  checks  that  it  is  within  bounds. 

d.  Output - 

ITMNEW  Time  for  next  record  (year,day,seconds) 


SETREF 
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a.  Functions  -  This  subroutine  sets  an  upper  limit  reference  flux. 


b.  Input - 


LATDIM 

LTDIM 

lEDIM 

ITMDIM 

IRDIM 

NRGDIM 

KPDIM 

ISPDIM 

FLXR 

FLXNRG 

FLXKP 

FLXMAT 


BNDLOC 

IFLAV 


R 

P 


VM 

ETA 

ALAM 

ALMDEL 

lEMAX 

TIMTAG 

TVAL 

ITMMAX 


Number  of  latitundinal  grid  spaces 

Number  of  local  time  (longitundinal)  grid  spaces 

Number  of  particle  species  to  be  traced 

Maximum  number  of  major  time  steps  for  this  run 

R  dimension  of  FLXMAT  arrays 

Energy  dimension  of  FLXMAT  arrays 

KP  ^mension  of  FLXMAT  arrays 

Plasma  mass  species  dimension 

R  values  at  which  FLXMAT  arrays  are  calculated  (Re) 

Energy  values  for  which  FLXMAT  arrays  are  calculated  (logio(eV)) 

KP  values  for  which  FLXMAT  arrays  are  calculated 

Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  in 

calculating  initial  and  boundary  flux  values  (logjoWctn^-s-ster-eV)) 

Location  of  outer  boundary  of  detailed  particle  traces 
Chemical  species  identifier 

1  means  electrons 

2  means  H+  ions 

3  means  O'*”  ions 

Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 
Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of  grid  pts 
in  equatonal  plane 
Flux  tube  volume  ((Re/nT)'2/3) 

Flux  tube  content  array  (weber^) 

Energy  invariant  vector  (eV{Re/nT)^ 

Wid±  of  energy  invariant  channels 
Maximum  number  of  energy  channels 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated  (seconds) 
Current  time  (seconds) 

Maximum  number  of  time  labels 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

TNORML  Utility  function  subprogram  to  calculate  run-normalized  time 
FLXVAL  Function  subprogram  to  calculate  Kp-dependent  flux  value  a  R=RR  for  particles 
of  energy  ENRG  and  Kp=FKP  by  interpolating  FLXMAT  array 


The  rationale  for  this  subroutine  is  discussed  in  Section  2.5.6  of  the  Final  Report  for  Contract 
#F19628-87-K-0001. 
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d.  Output - 

FLXREF  Upper  limit  to  reference  flux  (logio(#/cm2-s-ster-eV)) 


EFLOC 


MAINTENANCE  MANUAL  -  57 


a.  Functions  -  This  subroutine  finds  the  grid  location  of  physical  location  (RVAL,XLT). 


b.  Input  - 

RVAL  Radial  distance  (Re) 

XLT  Hour  angle  measured  eastward  from  noon  (radians) 

LL  Time  index 

LATDIM  Number  of  latitundinal  grid  spaces 

LTDIM  Number  of  local  time  (longitundinal)  grid  spaces 

ITMDIM  Maximum  number  of  major  time  steps  for  this  run 

ALOCT  Grid  local  time  array  (radians  eastward  from  noon) 

R  Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

PFIX  Subroutine  to  adjust  modulus  of  periodic  J  coordinate 

This  subroutine  locate  a  point  within  a  grid  square  and  then  linearly  interpolates  in  I  and  J  to  give 
the  non-integer  locations. 


d.  Output  - 

BI 

BJ 


Non-integer  I  location  of  (RVAL,XLT) 
Non-integer  J  location  of  (RVAL,XLT) 


EFBNDY 
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a.  Functions  -  This  subroutine  calculates  the  latitudes  and  widths  of  the  electric  field  boundarys  2 
and  3. 


b.  Input - 

LATDIM  Number  of  latitundinal  grid  spaces 

LTDIM  Number  of  local  time  (longitundinal)  grid  spaces 

ITMDIM  Maximum  number  of  major  time  steps  for  this  run 
LL  Time  label 

EQEDG  Equatorward  edge  of  auroral  oval  (degrees) 

STDOFF  Standoff  distance  (Re) 

VDROP  Cross-polar  cap  potential  drop 

ALOCT  Grid  local  time  array  (radians  eastward  from  noon) 

R  Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial  plane  (Re) 

COLAT  Grid  colatitude  array  (radians) 


c  Processing  -  following  are  the  subroutines  called  and  their  major  functions. 

EFLOC  Subroutine  to  find  grid  location  (BI.BJ)  of  physical  location  (RVAL.XLT) 
G3NTRP  Utility  function  subprogram  to  perform  a  general  3-d  linear  interpolation  of  an 
arbitrary  array  A(I,J,K)  at  point  (BI,BJ3K) 

The  rationale  for  this  subroutine  is  discussed  in  Section  2.4.2  of  the  Final  Report  for  Contract 
#F19628-87-K-0001. 

d.  Output - 

A  Radius  of  ellipse  measured  in  x  (sunward)  direction 

B  Radius  of  ellipse  measured  in  y  (duskward)  direction 

DX  Offset  of  ellipse  in  x(duskward)  direction 

DY  Offset  of  ellipse  in  y  (duskward)  direction 


FECON 
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a.  Functions  -  This  subroutine  obtains  the  time-normalized  observational  values. 


b.  Input - 


ISTART  Start  time  (year,day,  seconds) 

IINC  Increment  time  (year.day .seconds) 

lEND  Stop  time  (year, day  .seconds) 

riMDIM  Maximum  number  of  major  time  steps  per  run  of  the  program 

NAUGEL  Number  of  elements  in  the  augment^  input  array 
ITMMAX  Number  of  time  labels  used 

TIMTAG  Vector  giving  times  at  which  E  and  B  parameters  are  calculated 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 


PARGEN 

TIMING 

TILT 

DSTDFL 

EQTDFL 

STNDFL 

PCPDFL 

PATDFL 

CLPDFL 


Subroutine  to  obtain  values  from  the  environmental  data  base  and  interpolate  or 

extrapolate  as  appropriate  to  provide  data  at  a  normalized  time 

Subroutine  to  increment  time  for  next  electric-  and  magnetic  field  record 

Subroutine  to  calculate  the  Earth's  tilt  angle 

Subroutine  to  calculate  default  (Kp  driven)  Dst  value 

Subroutine  to  calculate  default  (Kp  driven)  equatorward  edge  of  auroral  zone 

value 

Subroutine  to  calculate  the  standoff  distance 

Subroutine  to  calculate  default  (Kp  driven)  cross-polar-cap  potential  value 
Subroutine  to  return  polar-cap  convection  pattern  typ 
Subroutine  to  determine  whether  or  not  to  use  the  collapsed  tail  version  of  the 
magnetic  field  model 


This  subroutine  calls  Subroutine  PARGEN  to  obtain  time-normalized  observational  data  that  is 
then  used  to  calculate  other  values  needed  by  the  electric  field  and  magnetic  field  routines. 


d.  Output - 

AUGPAR  Augmented  data  array  for  input  values 

MODE  Logical  vector  which  gives  whether  each  variable  comes  from  actual  data  or  a 
front  end  model. 


PARGEN 
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a.  Functions  -  Subroutine  to  obtain  values  from  the  environmental  data  base  and  interpolate  or 
extrapolate  as  appropriate  to  provide  data  at  a  normalized  time. 


b.  Input - 


ISTART 

HNC 

lEND 

ITMDIM 

NAUGEL 

ITMMAX 

TIMTAG 

NELTS 


Start  time  (year,day,  seconds) 

Increment  time  (year .day .seconds) 

Stop  time  (year.day .seconds) 

Maximum  number  of  major  time  steps  per  run  of  the  program 
Number  of  elements  in  the  augment^  input  array 
Maximum  number  of  time  labels 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated 
Number  of  elements  in  output  data  array 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 


INDATA 

SMOOTH 

DTXIPT 

DTNTRP 

TIMING 


Subroutine  to  read  in  data  for  the  MSM  during  development  and  testing. 
Subroutine  to  extract  data  from  input  array. 

Subroutine  to  return  interpolated  polar  cap  patterns 
Subroutine  to  return  interpolated  data  values 

Subroutine  to  increment  time  for  next  electric  and  magnetic  field  record 


This  subroutine  retrieves  observational  data  from  the  environmental  data  base  and  interpolates  as 
necessary  to  have  input  data  for  the  entire  run.  Mode  is  set  to  TRUE  if  there  exists  data  for  the  run 
within  the  time  constraints  of  array  IGAP.  If  the  gap  in  the  data  is  too  long,  MODE  is  set  false  and 
the  KP-based  default  models  are  used  to  compute  the  input  data  needed. 


d.  Output - 

PARRAY  Data  array  of  interpolated  data  values 

MODE  Logical  variable  telling  which  input  parameters  we  have  values  for 


INDATA 
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a.  Functions  -  Subroutine  to  read  in  data  for  the  MSM  during  development  and  testing. 


b.  Input - 

PARAM  File  name  to  read  input  data  from  (character) 

STARTT  Start  time  (year,day,seconds) 

ENDT  End  time  (year,day,seconds) 

NDIM  Maximum  number  of  data  points  to  read 


c.  Processing  -  No  other  routines  are  called. 

This  routine  opens  a  data  file  and  reads  the  observation  data.  This  routine  will  be  replaced  in  the 
operational  MSM  with  an  interface  routine  to  the  AWS  environmental  data  base. 


d.  Output  - 

DARRY  Array  containing  observational  data 
NUMNUM  Number  of  data  points  read 


GETMAT 
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a.  Functions  -  Subroutine  to  find  the  magnetic  field  matrices  needed  for  interpolation  in  order  to 
represent  current  geophysical  conditions. 


b.  Input  - 

IWANT  Different  magnetic  field  parameters 

=  1  -  XMIN  (GSM  X  location  of  where  field  line  going  through  grid  pt  crosses 
the  equatorial  (B-field  minimum)  plane  (Re)) 

=  2  -  YMIN  (GSM  Y  location  of  where  field  line  going  through  grid  pt  crosses 
the  equatori^  (B-field  minimum)  plane  (Re)) 

=  3  -  ZMIN  (GSM  Z  location  of  where  field  line  going  through  grid  pt  crosses 
the  equatorial  (B-field  minimum)  plane  (Re)) 

=  4  -  BMIN  (Equatorial  magnetic  field  strength  (nT)) 

=  5  -  VM  (Flux  tube  volume  (weber^)) 

LATDIM  Number  of  latitundinal  grid  spaces 

LTDIM  Number  of  local  time  (longitundinal)  grid  spaces 

BFPAR  Array  containing  geophysical  parameters  to  use  to  find  magnetic  field  matrices 

1  =  Standoff  distance  (Re) 

2  =  Tilt  angle  (degrees) 

3  =  Equatorward  edge  of  auroral  oval  (degrees) 

4  =  Dst  (nT) 

5  =  Collapse  parameter 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 


FNDBRK 

LOADBM 

ZEROBM 

OUTP 


Subroutine  to  find  the  proper  magnetic  field  indces  that  bracket  the  magnetic 
field  input  parameters 

Subroutine  to  load  individual  magnetic  field  matrices  from  the  magnetic  field 
super  matrix  into  the  work  magnetic  field  matrices 

Subroutine  to  zero  out  an  individual  magnetic  field  matrix  within  the  working 
magnetic  field  matrices 

Utility  subroutine  to  print  out  array  information 


d.  Output  - 


WORK  Internal  working  array 

BFLIM  Indices  of  magnetic  field  models  read 

BFEXST  Array  of  logical  variables  of  which  magnetic  field  model  matrices  exist 
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FNDBRK 


a.  Functions  -  Subroutine  to  find  the  magnetic  field  array  indices  that  bracket  the 
magnetic  field  input  parameters. 


b.  Input - 

PARVAL  Magnetic  field  geophysical  parameter 
PVALS  Array  of  magnetic  field  parameters 

IPDIM  Dimension  of  PVALS 


c.  Processing  -  No  other  subroutines  are  called. 

This  routine  finds  the  indices  of  the  values  in  array  PVAL  that  bracket  the  input 
geophysical  parameter. 


d.  Output - 


MIN 

MAX 


Lower  array  bound  index 
Upper  array  bound  index 
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MEXIST 


a.  Functions  -  Logical  functin  that  checks  to  see  if  a  particular  B-matrix  exists  in  the  B 
supermatrix 


b.  Intput- 

MSTND  Number  of  standoff  parameters,  currently  set  to  5 

MTTLT  Number  of  tilt  angle  parameters,  currently  set  to  5 

MINED  Number  of  aurord  equatorward  edge  parameters,  currently  set  to  1 6 

MDST  Number  of  Dst  parameters,  currently  set  to  8 

MSTCH  Number  of  tail  collapse  parameters,  currently  set  to  2 


c.  Processing  -  No  other  subroutines  are  called. 

This  function  uses  the  FORTRAN  "INQUIRE"  command  to  check  for  the  existence  of 
needed  B-field  arrays/ 

d.  Output  - 

MEXIST  true  if  B  field  arrays  exist,  false  otherwise 
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ZEROBM 


a.  Functions  -  Subroutine  to  zero  out  an  individual  magnetic  field  matrix  within  the 
working  magnetic  field  matrices  if  the  matrix  does  not  exist  in  the  supermatrix. 


b.  Input - 


LATDIM 

LTDIM 

I,J,K,L,M 

WORK 


Number  of  latitundinal  grid  spaces 
Number  of  local  time  (longitundinal)  ^d  spaces 
Indices  of  working  magnetic  field  matrices 
Working  magnetic  field  matrix 


c.  Processing  -  No  other  subroutines  are  called. 

So  that  the  program  does  not  crash  if  a  magnetic  field  matrix  does  not  exist,  it  is  zeroed 
out  The  printout  within  the  program  prints  that  no  magnetic  field  matrix  existed  for 
those  geophysical  conditions. 


d.  Output - 

WORK  Zeroed  out  working  magnetic  field  matrix 
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LOADBM 


a.  Processing  -  Subroutine  to  load  individual  matnetic  field  matrices  from  the  magnetic 
field  super-matrix  into  the  work  magnetic  field  matrices. 


c.  Input - 


IWANT 


LATDIM 

LTDIM 

I,J,K,L,M 

BFNDX 


5  different  magnetic  field  parameters 

=  1  -  XMIN  (GSM  X  location  of  where  field  line  going  through  grid 
pt  crosses  the  equatorial  (B-field  minimum)  plane  (Re)) 

=  2  -YMIN  (GSM  Y  location  of  where  field  line  going  through  grid  pt 
crosses  the  equatorial  (B-field  minimum)  plane  (Re)) 

=  3  -  ZMIN  (GSM  Z  location  of  where  field  line  going  through  grid  pt 
crosses  the  equatorial  (B-field  minimum)  plane  (Re)) 

=  4  -  BMIN  (Equatorid  magnetic  field  strength  (nT)) 

=  5  -  VM  ((Flux  tube  volume)‘2/3  ((Re/nT)-2/3)) 

Number  of  latitundinal  grid  spaces 

Number  of  local  time  (longitundinal)  ^d  spaces 

Indices  of  working  magnetic  field  matrices 

Array  containing  the  indices  of  the  magnetic  field  matrices  to  load  for 
geophysical  conditions  of  standoff  distance,  tilt  angle,  equatorward 
^ge  of  the  auroral  oval,  Dst,  and  tail  collapse  index 


c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  loads  individual  magnetic  field  matrices  from  the  offline  magnetic  field 
super-matrix  into  the  work  magnetic  field  matrices.  A  check  is  made  to  verify  that  the 
correct  matrix  has  been  retrieved.  It  this  check  fails  the  program  wiU  stop. 


d.  Output - 
Work 


Magnetic  field  matrix  work  array 


MAINTENANCE  MANUAL  -  67 


TC0NV2 


a.  Functions  -  Function  to  take  a  start  year,  start  decimal  day,  and  cuirent  decimal  day  to 
produce  a  value  that  is  the  number  of  seconds  from  midnight  of  the  start  year  and  day. 


b.  Input - 

YR  Current  year 

IXD  Current  day 

STRTYR  Start  year 

STRTDD  Start  day 


c.  Processing  -  No  other  subroutines  are  called. 


d.  Output - 

TCONV2  Seconds  from  midnight  of  start  day 
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TC0NV3 


a.  Functions  -  Function  to  take  a  start  year,  start  day,  current  year,  current  day,  and 
current  seconds  of  day  to  produce  a  value  that  is  the  number  of  seconds  from  midnight  of 
the  start  year  and  day. 


b.  Input - 

rriME  Current  time  (year,day,seconds) 

ISTART  Start  time  (year,day,seconds) 

c.  Processing  -  No  other  subroutines  are  called. 

d.  Output - 

TCONV3  Seconds  from  the  start  year  and  day 
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SMOOTH 


a.  Functions  -  Subroutine  to  extract  and  interpolate  data  from  observational  data  into  a 
usable  form  for  the  MSM. 


b.  Input - 

DARRY  Array  containing  input  observational  data 

NDIM  Maximum  number  of  data  points  in  DARRY 

NUMNUM  Number  of  data  points  in  DARRY 
STARTY  Start  year 

STARTD  Start  day 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions; 

TCONV2  Function  to  take  a  start  year,  start  decimal  day,  and  current  decimal 

day  to  produce  a  value  that  is  the  number  of  seconds  from  midnight  of 
the  start  year  and  day. 

This  subroutine  extracts  the  data  relevant  to  the  total  run  time. 


d.  Output- 


NA 

Total  number  of  data  points  found 

XA 

Time  (seconds) 

YA 

Data  point 

lERR 

Error  code 

=  0  no  errors  detected 

=  -1  error  in  data 
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DTNTRP 


a.  Functions  -  Subroutine  to  return  interpolated  data. 


b.  Input - 

X 

Time  (seconds) 

NA 

Number  of  data  points 

XA 

Time  array  of  observational  data  (seconds) 

YA 

Array  of  observed  data 

c.  Processing  -  No  other  subroutines  are  called. 


This  subroutine  takes  the  given  time,  finds  the  bracketing  time  in  the  XA  array  and 
linearly  interpolates  the  observational  data.  It  also  does  the  differential  DY/DX. 


d.  Output - 

Y  Interpolated  observational  data 

DYDX  Differential  DY/DX 

DELTA  The  difference  between  the  given  time  and  the  time  of  the 

observational  data 
lERR  Error  code 

=  0  no  problems  in  interpolation 
=  -l  error  detected 
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STNDOF 


a.  Functions  -  Subroutine  to  calculate  the  standoff  distance  from  solar  wind  velocity  and 
density  data. 

b.  Input  - 

VELOC  Solar  wind  velocity  data  (km/sec) 

DENS  Solar  wind  density  data  (cm'3) 


c.  Processing  -  No  other  subroutines  are  called. 

This  is  based  on  the  analytic  calculation  of  Alpbach  (1979). 


d.  Output - 


STAND  Standoff  distance  (Re) 
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FLXNIT 


a.  Functions  -  Subroutine  to  calculate  Kp  based  particle  number  flux  as  function  of  R, 
energy  and  Kp. 


b.  Input - 

BRDIM  Number  of  R  values  for  which  the  empirical  flux  array,  FLXMAT,  is 
calculated 

NRGDIM  Number  of  preset  energy  values  for  which  FLXMAT  is  calculated 
KPDIM  Number  of  KP  values  for  which  FLXMAT  is  calculated 
ISPDIM  Number  of  plasma  mass  species  (electrons,  H'*',  O'*',  etc.) 

FLXR  R  values  at  which  FLXMAT  arrays  are  calculated  (Re) 

FLXNRG  Energy  values  for  which  FLXMAT  arrays  are  calculated  (log|o(eV)) 
FLXKP  KP  values  for  which  FLXMAT  arrays  are  calculated 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

FLXCAL  Subroutine  to  compute  Kp-dependent  flux  at  L=3, 4,  6.6,  and  13  for 
electrons  of  given  energy  for  a  given  Kp  condition 
THRCAL  Subroutine  to  calculate  threshold  flux  at  R=3, 4, 6.6,  and  13  Re  for 
given  Kp  and  energy 

This  subroutine  sets  up  the  threshold  and  default  fluxes  for  the  program  run. 


d.  Output - 

FLXMAT  Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  in 
calculating  initial  and  boundary  flux  values  (logio(#/cm2-s-ster-eV)) 
THRMAT  Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  as 
threshold  fluxes.  (logio(#/cm2-s-ster-eV)) 
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FLXCAL 


a.  Functions  -  Subroutine  to  compute  Kp-dependent  flux  at  L=3, 4, 6.6  and  13  for 
different  species  of  given  energy  for  a  given  Kp  condition. 


b.  Input - 


KPDIM  Number  of  KP  values  for  which  FLXMAT  is  calculated 

ISPDIM  Number  of  plasma  mass  species  (electrons,  H+,  O'*",  etc.) 
FNRGLG  One  energy  value  for  which  FLXMAT  arrays  are  calculated 
aogio(eV)) 

FLKP  One  KP  value  for  which  FLXMAT  arrays  are  calculated 
ISPP  Chemical  species  identifier 

1  means  electrons 

2  means  H"*"  ions 

3  means  O'*"  ions 


c.  Processing  -  No  other  subroutines  are  called. 

The  rationale  for  this  subroutine  is  discussed  in  Section  2.5  of  the  Final  Report  for 
Contract  #F19628-87-K-0001. 

d.  Output  - 

FLX3  Flux  at  L=3  (#/cm-2-sec-ster-eV)  for  given  energy  for  given  Kp 

FLX4  Flux  at  L=4  (#/cm-2-sec-ster-eV)  for  given  energy  for  given  Kp 

FLX6  Flux  at  L=6  (#/cm-2-sec-ster-eV)  for  given  energy  for  given  Kp 

FLX 1 3  Flux  at  L=  1 3  (#/cm‘2-sec-ster-eV)  for  given  energy  for  given  Kp 
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FLXTRP 


a.  Functions  -  Function  subprogram  to  return  Logjo  of  empirical  flux  value  interpolated 
between  values  at  L=3, 4,  6.6,  and  13. 


b.  Input - 

RLOG  Logio  of  radial  distance  to  be  interpolated 

FLX3  Flux  at  L=3  (#/cm'^-sec-ster-eV)  for  given  energy  for  given  Kp 

FLX4  Flux  at  L=4  (#/cm‘2-sec-ster-eV)  for  given  energy  for  given  Kp 

FLX6  Flux  at  L=6  (#/cm'2-sec-ster-eV)  for  given  energy  for  given  Kp 

FLXl  3  Flux  at  L=13  (#/cm-2-sec-ster-eV)  for  given  energy  for  given  Kp 

c.  Processing  -  No  other  subroutines  are  called. 

d.  Output - 

FLXTRP  Flux  value  interpolated  in  radial  distance 
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FLXVAL 


a.  Functions  -  Function  subprogram  to  calculate  Kp-dependent  flux  value  for  particles  at 
a  given  radial  distance,  energy,  and  Kp  conditions  by  interpolating  the  FLXMAT  array. 


b.  Input - 


ISP 


FKP 

RR 

PP 

ENRG 

IRDIM 

NRGDIM 

KPDIM 

ISPDIM 

FLXR 

FLXNRG 

FLXKP 


Vector  of  chemical  species  identifier 

1  means  electrons 

2  means  H"*"  ions 

3  means  O'*"  ions 
Kp  for  current  time 

Radial  distance  of  particle  (Re) 

Hour  angle  (measured  eastward  from  noon  in  radians)  in  equatorial 
plane 

Energy  (eV) 

Number  of  R  values  for  which  the  empirical  flux  array,  FLXMAT,  is 
calculated 

Number  of  preset  energy  values  for  which  FLXMAT  is  calculated 
Number  of  KP  values  for  which  FLXMAT  is  calculated 
Number  of  plasma  mass  species  (electrons,  H"*",  0+,  etc.) 

R  values  at  which  FLXMAT  arrays  are  calculated  (Re) 

Energy  values  for  which  FLXMAT  arrays  are  calculated  (logio(ey)) 
KP  values  for  which  FLXMAT  arrays  are  calculated 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

G3NTRP  Utility  function  subprogram  to  perform  a  general  3-d  linear 

interpolation  of  ari  arbitrary  array  A(I,J,K)  at  point  (BI,BJ,BK) 

This  subroutine  performs  a  general  3-d  interpolation  in  radial  distance,  Kp,  and  energy. 

d.  Output  - 

FLXVAL  Interpolated  flux 
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EFIELD 


a.  Functions  -  Subroutine  to  return  values  of  the  potential  on  the  northern  hemisphere 
grid,  southern  hemisphere  grid,  and  the  average  of  the  two  hemispheres. 


b.  Input - 
KPATT 


PCP 

DEQDT 

ASOUTH 

BSOUTH 

DXS 

DYS 

ANORTH 

BNORTH 

DXN 

DYN 


COLAT 

ALOCl 

MODE 

LATDIM 

LTDIM 

JWRAP 

ITMCUR 

ITMDIM 

ICNTRL 


Polar  cap  pattern  type 
=  0  Bz  >  0 

=  1  Bz  <  0  with  stronger  flow  on  dawn  side  of  polar  cap 
-  2  Bz  <  0  with  symmetric  flow  in  polar  cap 
=  3  Bz  <  0  with  stronger  flow  on  dusk  side  of  polar  cap 
Cross  polar  cap  potential  drop  (kV) 

Time  rate  of  change  of  the  equatorward  edge  of  the  auroral  zone 
(degrees/hour) 

Southern  hemisphere  radius  of  ellipse  measured  in  x  (sunward) 
direction 

Southern  hemisphere  radius  of  ellipse  measured  in  y  (duskward) 
direction 

Southern  hemisphere  offset  of  ellipse  measured  in  x(sunward) 
direction 

Southern  hemisphere  offset  of  ellipse  measured  in  y  (duskward) 
direction 

Northern  hemisphere  radius  of  ellipse  measured  in  x  (sunward) 
direction 

Northern  hemisphere  radius  of  ellipse  measured  in  y  (duskward) 
direction 

Northern  hemisphere  offset  of  ellipse  measured  in  x  (sunward) 
direction 

Northern  hemisphere  offset  of  ellipse  measured  in  y  (duskward) 
direction 

Grid  colatitude  array  (radians) 

Grid  local  time  array  (radians  eastward  from  noon) 

Logical  variable  telling  which  input  parameters  we  have  values  for 

Number  of  latitundiral  grid  spaces 

Number  of  local  time  (longitundinal)  grid  spaces 

Number  of  points  of  overlap  in  J  direction 

Current  time  label 

Maximum  number  of  major  time  steps  per  run  of  the  program 
=  1  means  different  formulas  are  used  in  regions  1,  2,  3, 

=  2  means  Heppner-Maynaru  formula  is  used  for  all  latitudes  ,  but 
scaled  to  externally  specified  cross  polar  cap  potential  drop  and  ellipse 
parameters 
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=  - 1  means  Heppner-Maynard  formula  is  used  for  all  latitudes, 
unsealed. 

=  -2  should  not  be  used.  It  is  the  form  used  by  the  Rice  Convection 
Model 

ITOP  =  1  means  the  ellipse  parameters  A,  B,  DX,  and  DY  for  the  polar  cap 
boundary  are  comput^  internally  in  the  subroutine.  This  is  the 
normal  mode  for  the  MSM. 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

EMODEL  Returns  the  electric  potential  arrays  on  the  northern  hemisphere  grid, 
southern  hemisphere  grid,  and  the  average  of  the  two  hemispheres 

The  major  function  of  this  subroutine  is  to  translate  the  KPATT  pattern  types  given  by  the 
University  of  Texas,  Dallas  to  the  interally  used  IP  ATT  pattern  types  of  the  Heppner- 
Maynard  empirical  model.  It  also  keeps  track  of  which  hemisphere  is  being  modelled  and 
averages  the  output  from  the  two  hemispheres. 


d.  Output  - 


V  Electric  potential  distribution  on  grid  (average  of  VNORTH  and 

VSOUTH)  (Volts) 

VNORTH  Northern  hemisphere  electric  potential  distribution  (Volts) 
VSOUTH  Southern  hemisphere  electric  potential  distribution  (Volts) 
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PWRCAL 


a.  Functions  -  Subroutine  to  estimate  precipitating  leectron  energy  flux  poleward  of  the 
main  MSM  modeling  region  by  comparing  flux  within  the  modeling  region  with  AFGL 
statistical  values. 


b.  Input  - 


LATDIM 

LTDIM 

ISPDIM 

ITMCUR 

ITMDIM 

FKP 

COLAT 

ALOCT 

ALPHA 

BETA 

BNDLOC 

A 

B 

DX 

DY 


Number  of  latitundinal  grid  spaces 
Number  of  local  time  (longitundinal)  grid  spaces 
Number  of  plasma  mass  species  (electrons,  H"*",  O'*",  etc.) 
(Turrent  time  label 

Maximum  number  of  major  time  steps  per  run  of  the  program 

Kp  for  current  time 

Grid  colaiitude  array  (radians) 

Grid  local  time  array  (radians  eastward  from  noon) 
Latitundinal  grid  spacing  vector 
Longitudinal  grid  spacing  vector 
Location  of  outer  boundary  of  detailed  particle  traces 
Radius  of  ellipse  measured  in  x  (sunw^)  direction 
Radius  of  ellipse  measured  in  y  (duskward)  direction 
Offset  of  ellipse  measured  in  x  (sunward)  direction 
Radius  of  ellipse  measured  in  y  (duskward)  direction 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

THET  Function  that  gives  equation  for  and  electric  field  boundary  ellipse  in 
flat  polar  coordinates 

The  rationale  for  this  subroutine  is  discussed  in  Section  2.6.5.2  of  the  Final  Report  for 
Contract  #F19628-87-K-0001. 

d.  Output  - 

FLXSUM  Total  precipitation  energy  flux  array  (integrated  over  species  for  (1) 
electrons  (2)  and  (3)  O’*")  (ergs/cm^-sec) 

EAVG  Average  precipitating  electron  energy  for  (1)  electrons,  (2)  H'''  and 
(3)  0+(eV) 
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WKRATE 

a.  Functions  -  Function  subroutine  to  evaluate  weak  precipitation  loss  rate. 


b.  Input  - 


RMID  R  value  at  point  where  function  is  to  be  evaluated  (Re) 

RPPMID  Estimate  of  plasmapause  radius  at  midnight  local  time(Re) 

PMID  Local  time  hour  angle  in  equatorial  plane  (radians  from  local  noon) 
ENRG  Particle  energy  (eV) 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

RLYONS  Function  to  evaluate  Lyons- based  weak  loss  rate 

The  rationale  for  this  subroutine  is  discussed  in  Section  2.6.3  of  the  Final  Report  for 
Contract  #F19628-87-K-0001. 

d.  Output - 

WKRATE  Estimate  of  weak  precipitation  loss  rate 
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RLYONS 


a.  Functions  -  Function  to  evaluate  Lyons-based  weak  loss  rate. 

b.  Input - 

RMID  R  value  at  point  where  function  is  to  be  evaluated  (Re) 

ENRG  Particle  energy  (eV) 

c.  Processing  -  No  other  subroutines  are  called. 

The  rationale  for  this  subroutine  is  discussed  in  Section  2.6.3  of  the  Final  Report  for 
Contract  #F19628-87-K-0001. 

d.  Output - 

RLYONS  Estimate  of  weak  precipitation  loss  rate  from  L.  Lyons  formula 
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G3TRPA 


a.  Functions  -  Utility  function  subprogram  to  perform  a  general  3-d  linear  interpolation 
of  an  angular  array  A(I  J,K)  at  point  (BI.BJ.BK) 


b.  Input - 
A 

MAX 

MAX 

KMAX 

BI 

BJ 

BK 


Array  to  be  interpolated 
I  dimension  of  array  A 
J  dimension  of  array  A 
K  dimension  of  array  A 

Floating  point  value  to  interpolate  in  I  dimension 
Roating  point  value  to  interpolate  in  J  dimension 
Boating  point  value  to  interpolate  in  K  dimension 


c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  uses  the  standard  linear  interpolation  technique  to  interpolate  an  angular 
array  in  3  dimensions. 


d.  Output - 


G3TRPA  Interpolated  point  from  array  A 
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THRCAL 


a.  Functions  -  Subroutine  to  calculate  threshold  flux  at  R=3, 4,  6.6,  and  13  Re  for  given 
Kp  value  and  energy. 


b.  Input - 


FNRGLG 

FKP 

NRGNDX 

KPNDX 

IRDIM 

NRGDIM 

KPDIM 

FLXMAT 


One  energy  value  for  which  FLXMAT  arrays  are  calculated 
(log,o(eV)) 

One  KP  value  for  which  FLXMAT  arrays  are  calculated 
Energy  calculation  index 
Kp  cdculation  index 

Number  of  R  values  for  which  the  empirical  flux  airay,  FLXMAT,  is 
calculated 

Number  of  preset  energy  values  for  which  FLXMAT  is  calculated 
Number  of  KP  values  for  which  FLXMAT  is  calculated 
Array  of  empirical  fluxes  as  function  of  R,  energy,  and  KP  for  use  in 
calculating  initial  and  boundary  flux  values  (logio(#/cm2-s-ster-eV)) 


c.  Processing  -  No  other  subroutines  are  called. 


The  rationale  for  this  subroutine  is  discussed  in  Section  2.5.8  of  the  Final  Report  for 
Contract  #F19628-87-K-0001. 

d.  Output  - 


THR 


Value  for  threshold  flux  (particles/cm^-s-ster-eV) 
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HJCDFL 


a.  Functions  -  Subroutine  to  calculate  the  energy-dependent  ETA  array  from  Kp  and  the 
location  of  the  grid  points  by  interpolating  the  empirical  FLXMAT  array. 


b.  Input - 


ITM 

FKP 

R 

P 

VM 

ALAM 

KDIM 

NRGDIM 

KPDIM 

FLXMAT 


FLXR 

FLXNRG 

FLXKP 

ALMDEL 

LATDIM 

LTDIM 

ITMDIM 

BNDLOC 

lEMAX 

lEDIM 

IFLAV 


lEBEG 

lEEND 


Current  time  label 
Current  Kp 

Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial 
plane  ^e) 

Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of 
grid  pts  in  equatorial  plane 
Flux  tube  volume  ((Re/nT)'2^) 

Energy  invariant  vector  (eV(Re/nT)2/3) 

Number  of  R  values  for  which  the  empirical  flux  array,  FLXMAT,  is 
calculated 

Number  of  preset  energy  values  for  which  FLXMAT  is  calculated 
Number  of  KPval'  s  for  which  FLXMAT  is  calculated 
Array  of  empirical  duxes  as  function  of  R,  energy,  and  KP  for  use  in 
calculating  initial  and  boundary  flux  values  (logio(#/cm2-s-ster-eV)) 

R  values  at  which  FLXMAT  arrays  are  calculated  (Re) 

Energy  values  for  which  FLXMAT  arrays  are  calculated  (logio(eV)) 

KP  values  for  which  FLXMAT  arrays  are  calculated 

Width  of  energy  invariant  charuiels 

Number  of  latitundinal  grid  spaces 

Number  of  local  time  Gongitundinal)  grid  spaces 

Maximum  number  of  major  time  steps  per  mn  of  the  program 

Location  of  outer  boundary  of  detailed  particle  traces 

Maximum  number  of  energy  channels 

Number  of  invariant  energy  species  traced  by  the  program 

(Themical  species  identifier 

1  means  electrons 

2  means  ions 

3  means  O'*'  ions 
Beginning  energy  index 
Ending  energy  index 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

FLXVAL  Function  subprogram  to  calculate  Kp-dependent  flux  value  at  given 
radial  distance,  energy  and  Kp  by  interpolating  FLXMAT  array. 
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This  routine  is  used  as  the  MSM  default  model  when  full  particle  traces  are  done.  The 
subroutine  interpolates  the  FLXMAT  arrays  for  the  given  energies  for  all  grid  points. 

d.  Output - 

ETA  Flux  tube  content  array  (webeH) 

EFLUX  Precipitation  energy  flux  array  (ergs/cm^-sec) 
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RMVBSH 


a.  Functions  -  Subroutine  to  extrapolate  magnetic  field  matrices  into  extremely  stretched 
or  open  regions. 


b.  Input - 

WORK  Working  magnetic  field  matrix 

LATDIM  Number  of  latitundinal  grid  spaces 

LTDIM  Number  of  local  time  (longitundinal)  grid  spaces 


c.  Processing  -  No  other  subroutines  are  called. 


To  prepare  the  magnetic  field  matrices  for  interpolation,  previously  assigned  'very  large 
numbers'  to  signify  that  the  magnetic  field  extended  beyond  50  Re  are  removed.  The 
subroutine  looks  for  the  closest  value  in  local  time  (J)  and  linearly  interpolates  for  the 
latitudinal  (I)  grid  points. 


d.  Output - 

WORK  Revised  working  magnetic  field  matrix 
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DSTDFL 


a.  Functions  -  Subroutine  to  calculate  default  (Kp-driven)  Dst  value 


b.  Input  - 


MODE 

AUGPAR 

NAUGEL 

ITMDIM 

ITM 

ITMMAX 

TIMTAG 


Logical  variable  telling  which  input  parameters  we  have  values  for 
Augmented  data  array  for  input  values 
Number  of  elements  in  the  augmented  input  array 
Maximum  number  of  major  time  steps  per  run  of  the  program 
Current  time  label 
Maximum  number  of  time  labels 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions; 

DTNTRP  Subroutine  to  return  interpolated  data  values 

The  subroutine  uses  the  Kp  value  in  the  AUGPAR  array  for  the  given  time  and  calculates 
Dst.  This  value  is  then  put  into  the  AUGPAR  array.  Subroutine  DTNTRP  is  called  to 
give  the  DY/DX  value  dso  needed  in  AUGPAR. 


d.  Output  - 


AUGPAR  Augmented  data  array  for  input  values 
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EQTDFL 


a.  Function  -  Subroutine  to  calculate  default  (Kp-driven)  equatorward  edge  of  the  auroral 
oval  value. 


b.  Input - 


MODE 

AUGPAR 

NAUGEL 

ITMDIM 

ITM 

ITMM/iJC 

TIMTAG 


Logical  variable  telling  which  input  parameters  we  have  values  for 
Augmented  data  array  for  input  values 
Number  of  elements  in  the  augmented  input  array 
Maximum  number  of  major  time  steps  per  run  of  the  program 
Cuirent  time  label 
Maximum  number  of  time  labels 

Vector  giving  times  at  which  E  and  B  parameters  are  calculated 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

DTNTRP  Subroutine  to  return  interpolated  data  values 

The  subroutine  uses  the  Kp  value  in  the  AUGPAR  array  for  the  given  time  and  calculates 
the  location  of  the  equatorward  edge  of  the  auroral  oval.  The  algorithm  is  given  in  a  JGR 
paper  by  Gussenhoven  et  al.  (1983).  This  value  is  then  put  into  the  AUGPAR  array. 
Subroutine  DTNTRP  is  called  to  give  the  DY/DX  value  also  needed  in  AUGPAR. 


d.  Output - 


AUGPAR  Augmented  data  array  for  input  values 
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PDPDFL 


a.  Functions  -  Subroutine  to  calculate  default  (Kp-driven)  cross-polar-cap  potential 
value. 


b.  Input - 

MODE  Logical  variable  telling  which  input  parameters  we  have  values  for 
XKP  Current  KP  value 

c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  uses  the  algorithms  of  Reiff  et  al  to  calculate  the  cross-polar-cap  potential 
from  given  Kp. 

d.  Output  - 

PCP  Cross-polar  cap  potential  (kV) 
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PATDFL 


a.  Functions  -  Subroutine  to  return  polar  cap  convection  pattern  type  of  the  basis  of  the 
measurements  of  the  By  and  Bz  components  of  the  interplanetary  magnetic  field. 


b.  Input  - 

MODE  Logical  variable  telling  which  input  parameters  we  have  values  for 
MODEBY  Logical  variable  telling  if  we  have  By  data 
MODEBZ  Logical  variable  telling  if  we  have  Bz  data 


c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  determines  the  pattern  type  using  interplanetary  magnetic  field  data: 
Polar  cap  pattern  type 
=  0  Bz  >  0 

=  1  Bz  <  0  with  stronger  flow  on  dawn  side  of  polar  cap 
=  2  Bz  <  0  with  symmetric  flow  in  polar  cap 
=  3  Bz  <  0  with  stronger  flow  on  dusk  side  of  polar  cap 
If  no  data  is  available,  pattern  #2  is  the  default. 


d.  Output  - 


IPATT  Polar  cap  pattern  type 
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CLPDFL 


a.  Functions  -  Subroutine  to  determine  whether  or  not  to  use  the  collapsed  tail  version  of 
the  magnetic  field  model. 


b.  Input - 

MODE  Logical  variable  telling  which  input  parameters  we  have  values  for 

c.  Processing  -  No  other  subroutines  are  called. 

If  mode  is  false,  no  value  has  been  returned  from  the  environmental  data  base  and  the 
default  value  is  set  to  1  (no  collapse). 


d.  Output - 


CLAPSE  Value  of  magnetotail  collapse  parameter 
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STNDFL 


a.  Functions  -  Subroutine  to  calculate  the  standoff  distance. 


b.  Input - 


MODE 

MODVEL 

MODDEN 

SWVEL 

SWDEN 

XKP 


Logical  variable  telling  which  input  parameters  we  have  values  for 
Logical  variable  telling  if  we  have  solar  wind  velocity  data 
Logical  variable  telling  if  we  have  solar  wind  density  data 
V^ue  of  solar  wind  velocity  data 
Value  of  solar  wind  density  data 
Current  Kp  value 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

STNDOF  Subroutine  to  calculate  the  standoff  distance  according  to  a  formula 

published  by  Alpbach  (1979) 

If  solar  wind  velocity  and  density  data  are  available  Subroutine  STNDOF  does  the  actual 
calculation.  Otherwise  the  default  is  a  Kp-based  formula. 


d.  Output - 


STAND  Standoff  distance  (Re) 
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TILT 

a.  Functions  -  Subroutine  to  calculated  the  earth's  tilt  angle. 

b.  Input - 

DAY  Day  of  year 

YEAR  Year 

c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  currently  sets  the  tilt  angle  at  0.0. 

d.  Output - 

XTILT  Tilt  angle 
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AURL2S 


a.  Function  -  This  subroutine  determines  the  default  Hardy  precipitating  ion  flux. 


b.  Input - 


FKP  Current  Kp  value 

COLAT  Grid  colatitude  array  (radians) 

AIXXZT  Time  dependent  magnetic  loc^  time  grid 

LATDIM  Number  of  latitudinal  grid  lines ) 

LTDIM  Number  of  local  time  (longitude)  grid  lines 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  function: 

REGEN  Subroutine  used  in  evaluation  of  precipitatin  ion  fluxes 

EFUN  Subroutine  used  in  evaluation  of  precipitatin  ion  fluxes 

These  set  of  subroutines  were  developed  by  Dr.  David  Hardy  at  the  Air  Force 
Geophysics  Laboratory,  Bedford,  Mass. 


d.  Output - 

AEFLUX  The  integral  ion  energy  flux  (ergs/cm^-sec) 
AEMEAN  The  average  energy  (eV) 
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OPTERR 


a.  Functions  -  Subroutine  to  calculate  the  error  and  standard  deviation  between  the  MSM 
flux  and  observational  geosynchronous  satellite  data. 


b.  Input - 

FLUX  Particle  flux  array  (cm^  s)'^ 

VM  (Flux  tube  volume)^  ((Re/nT)-2/3) 

LATDIM  Number  of  latitundinal  grid  spaces 

LTDIM  Number  of  local  time  Gongitundinal)  grid  spaces 

lEDIM  Maximum  number  of  energy  channels 

lEMAX  Number  of  invariant  energy  species  traced  by  the  program 

ALAM  Energy  invariant  vector  (eV(Re/nT)2/3) 

ALMDEL  Wid^  of  energy  invariant  channels 

THRSH  Threshold  energy  beyond  which  particles  are  not  traced  and  empirical 
data  are  used 

ITMDIM  Maximum  number  of  major  time  steps  per  run  of  the  program 

IFLA  V  Chemical  species  identifier 

1  means  electrons 

2  means  11+  ions 

3  means  0+  ions 

ISTART  Start  time  (year, day, seconds) 

END  End  time  (year,day,seconds) 

R  Array  giving  radial  distance  of  grid  pts  in  magnetospheric  equatorial 

plane  (Re) 

P  Array  giving  hour  angle  (measured  eastward  from  noon  in  radians)  of 

grid  pts  in  equatorial  plane 

TIMTAG  Vector  giving  times  at  which  E  and  B  parameters  are  calculated 
ITMMAX  Number  of  time  labels  in  run 


c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

TC0NV2  Function  to  take  a  start  year,  start  decimal  day,  and  current  decimal 

day  to  produce  a  value  that  is  the  number  of  seconds  from  midnight  of 
the  start  year  and  day 

READ3D  Subroutine  to  read  a  record  from  the  standard  MSM  disk  file  format 

TNORML  Utility  function  subprogram  to  calculate  run-normalized  time 

EFLOC  Subroutine  to  find  grid  location  (BI,BJ)  of  physical  location 
(RVAL,XLp 

G3NTRP  Utility  function  subprogram  to  perform  a  general  3-d  linear 

interpolation  of  an  arbitrary  array  A(T,J,K)  at  point  (BI,BJ,BK) 
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For  the  satellite  times  and  energies  available,  the  subroutine  calculates  and  inteipolates  the 
model  flux  values  at  geosynchronous  orbit.  The  error  is  defined  as  the  average  difference 
between  the  log  of  the  model  flux  and  the  log  of  the  satellite  flux.  The  standard  deviation 
is  the  usual  de^ition.  The  subroutine  averages  over  all  available  satellites.  The  format  of 
the  file  'EPSAT  will  need  to  be  changed  when  the  MSM  begins  to  access  the  AWS 
environmental  data  base.  The  standard  deviation  is  not  saved,  just  printed  out. 


d.  Output - 


ERSHFT  Vector  of  error  values 
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WRTVEC 

a.  Function  -  This  subroutine  writes  to  disk  the  energy  invariant,  the  threshold  energies, 
and  the  error  shift  for  each  particle  energy  species  each  time  step. 


b.  Input - 


NOUNIT  Logical  unit  number  from  which  to  read  file 

IRDOUT  Output  direct  access  record  number 
lEMAX  Number  of  particle  energy  species  for  run 
lEDIM  Dimension  of  panicle  energy  species  array 
ALAM  Vector  of  energy  invariant  values  used  in  run 
THRSH  Vector  of  full-traceback/default  value  used  in  run 
ERSHFT  Vector  of  error  values  for  this  time  interval 
IFLAV  Vector  of  chemical  species  identifier 

1  means  electrons 

2  means  H'*'  ions 

3  means  O'*"  ions 


c.  Processing  -  No  other  subroutines  are  called. 

This  routine  opens  the  appropriate  file,  writes  the  vectors  to  the  file,  and  closes  the  file. 


d.  Output  -  The  vectors  are  output  to  unit  number  NOUNIT. 
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CEXRAT 


a.  Function  -  Function  subprogram  to  return  charge  exchange  loss  rate  (sec-i)  for  ions  of 
species  ISP,  energy  ENRG  (eV),  at  L=RLOC  (Re)  for  sunspot  number  SSN.  This 
routine  is  based  on  a  table  generated  by  James  Bishop  of  the  University  of  Michigan. 


b.  Input  - 


ISP 

Species  Identifier 

ISP=2  for  Ions 

ISP=3  for  0"^  Ions 

ENRG 

Energy  in  eV 

RLOC 

Radid  location  (Re) 

SSN 

Sunspot  number 

DKTIME 

Table  of  ion  decay  times 

IRDK 

Radial  dimension  of  DKTIME  array 

INRGDK 

Energy  dimension  of  DKTIME  array 

ISOLDK 

Sunspot  number  dimension  of  DKTIME  array 

lONDK 

Number  of  ion  species  in  DKTIME  array 

c.  Processing  -  following  are  the  subroutines  called  and  their  major  functions: 

G3NTRP  Utility  function  subprogram  to  perform  a  general  3-d  linear 

interpolation  of  an  arbitrary  array  A(I  J,K)  at  point  (BI,BJ,BK) 

This  routine  interpolates  the  decay  time  array  in  radial  distance,  energy  and  sunspot 
number. 


d.  Output - 


CEXRAT  Ion  charge  exchange  loss  rate  (sec'O 
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READDK 


a.  Function  -  Subroutine  to  read  ion  charge  exchange  decay  table  furnished  by  James 
Bishop  of  the  University  of  Michigan. 


b.  Inpui  - 

IRDK  Radial  dimension  of  DKTIME  array 
INRGDK  Energy  dimension  of  DKTIME  array 
ISOLDK  Sunspot  number  dimension  of  DKTIME  array 

lONDK  Number  of  ion  species  in  DKTIME  array 

c.  Processing  - 

Reads  the  input  table  of  ion  decay  times. 

d.  Output  - 

DKTIME  Table  of  ion  decay  times 
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FLX2ET 


a  Function  -  Convert  from  particle  flux  (particles/cm^/s)  to  invariant  density  eta 
(particles/Weber) 


b.  Input - 


LATDIM 

LTDIM 

lEDIM 

lEMAX 

riMDIM 

riM 

IFLAV 

ALAM 

ALMDEL 

BNDLOC 

VM 

FLUX 


Number  of  latitudinal  grid  points 

Number  of  longitudind  (local  time)  grid  points 

Maximum  number  of  model  energy  channels 

Actual  number  of  model  energy  channels 

Maximum  time  depth 

Time  index 

Vector  giving  charge  and  mass  species  of  particles 

1  =  electrons,  2  =  H+  ions,  3  =  O'*"  ions 

Energy  invariant  vector 

WidA  of  invariant  energy  channels 

Boundary  location  array 

(Flux  tube  volume)'2/3 

Particle  number  flux  (#/cm2/s) 


c.  Processing  -  No  other  subroutines  are  called. 

This  subroutine  uses  a  simple  formula  to  translate  from  number  flux  FLUX  to  invariant 
density  ETA. 


d.  Output - 


ETA 


Invariant  number  density  (particles  /  Weber) 


Appendix  B 
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ET2FLX 


a.  Function  -  Convert  from  invariant  density  eta  (particles/Weber)  to  particle  number  flux 
(particles/cm2/s) 


b.  Input  - 


LATDIM 

LTDIM 

EDIM 

EMAX 

ITMDIM 

riM 

ELAV 


ALAM 

ALMDEL 

BNDLOC 

VM 

ETA 


Number  of  latitudinal  grid  points 

Number  of  longitudinal  (local  time)  grid  points 

Maximum  number  of  model  energy  channels 

Actual  number  of  model  energy  channels 

Maximum  time  depth 

Time  index 

Vector  giving  charge  and  mass  species  of  panicles 

1  =  electrons,  2  =  !!■*■  ions,  3  =  O'*"  ions 

Energy  invariant  vector 

Width  of  invariant  energy  channels 

Boundary  location  array 

(Flux  tube  volume)'2/3 

Invariant  number  density  (particles  /  Weber) 


c.  Processing  -  No  other  subroutines  are  called. 


This  subroutine  uses  a  simple  fomiula  to  translate  from  invariant  density  ETA  to  number 
flux  FLUX. 


d.  Output  - 


FLUX 


Particle  number  flux  (#/cm2/s) 
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PROGRAM  MSMCON 

VERSION  1.0 
1.1 
1.2 
1.3 

PROGRAMMER:  BOB  SPIRO 


msml.for 


DATE:  NOVEMBER  10,  1988 
MARCH  26,  1990 
MAY  11,  1990 
JULY  01,  1990 


PURPOSE:  MSMCON  IS  THE  MAIN  PROGRAM  FOR  THE  MAGNETOSPHERIC 

SPECIFICATION  MODEL.  MSMCON  CALLS  THE  SUBROUTINES  PPTCON, 
HIEPAR,  AND  OUTPUT. 

PARAMETER  (LATDIM=62 , LTDIM=51 , IEDIM=30,  ITMDIM=50, 

2  NAUGEL=28, IRDIM=4,NRGDIM=29,KPDIM=7,  ISPDIM=3, 

3  IRDK=18, INRGDK=13, ISOLDK=2, IONDK=2, KPPLUS=9) 

LATDIM  GIVES  THE  NUMBER  OF  LATITUINAL  GRID  LINES  (ALIASED  AS  IDIM 
IN  SOME  ROUTINES) 

LTDIM  GIVES  THE  NUMBER  OF  LOCAL  TIME  (LONGITUDE)  GRID  LINES  (ALIASED 
AS  JDIM  IN  SOME  ROUTINES) 

lEDIM  GIVES  THE  NUMBER  OF  INVARIANT  ENERGY  SPECIES  TRACED  BY  THE 
PROGRAM 

ITMDIM  GIVES  THE  MAXIMUM  NUMBER  OF  MAJOR  TIME  STEPS  PER  RUN  OF  THE 
PROGRAM 

NAUGEL  GIVES  THE  NUMBER  OF  ELEMENTS  IN  THE  AUGMENTED  INPUT  ARRAY 

IRDIM  GIVES  THE  NUMBER  OF  R  VALUES  FOR  WHICH  THE  EMPIRICAL  FLUX 
ARRAY,  FLXMAT,  IS  CALCULATED 

NRGDIM  GIVES  THE  NUMBER  OF  PRESET  ENERGY  VALUES  FOR  WHICH  FLXMAT  IS 
CALCULATED 

KPDIM  GIVES  THE  NUMBER  OF  KP  VALUES  FOR  WHICH  FLXMAT  IS  CALCULATED 

KPPLUS  GIVES  THE  KP  DIMENSION  OF  THE  AUGMENTED  FLXMAT  ARRAY 
(KPDIM  +  2) 

ISPDIM  GIVES  THE  NUMBER  OF  PLASMA  MASS  SPECIES  (ELECTRONS, H+, 0+, ETC) 


CHARACTER* 80  CHID 

COMMON  LUNIT  CONTAINS  LOGICAL  UNIT  NUMBERS  FOR  INPUT  AND  OUTPUT 
COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT,  LUIDAT,  LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG,  LUFLSM,  LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO,  LUENCH 

COMMON  IRDREC  CONTAINS  RECORD  NUMBERS  FOR  PARTICE  TRACE  (IRECPT) 
AND  E  AND  B  FIELD  FILES  (IRECEB) 

COMMON  /IRDREC/  IRECPT, IRECEB, I RDBEG 

COMMON  SUN  CONTAINS  THE  SUN  SPOT  NUMBER  FOR  THE  ION  CHARGE 
EXCHANGE  ALGORITHM 
COMMON  /SUN/  SSN 

WITH  FEW  EXCEPTIONS,  MOST  OF  THE  ARRAYS  USED  IN  THE  PROGRAM  ARE 
DIMENSIONED  HERE  IN  MSMCON. 

DIMENSION  ISTART(3) ,IINC(3) ,IEND(3) 

DIMENSION  ETA (LATDIM, LTDIM, lEDIM) , EFLUX (LATDIM, LTDIM, lEDIM) , 

2  FLXSUM (LATDIM, LTDIM, 3) , EAVG (LATDIM, LTDIM, 3) , 

3  FLUX (LATDIM, LTDIM, lEDIM) 

DIMENSION  VM (LATDIM, LTDIM, ITMDIM) , V (LATDIM, LTDIM, ITMDIM) , 
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MSM00480 

MSM00490 

MSM00500 

MSM00510 

MSM00520 

MSM00530 

MSM00540 

MSM00550 

MSM00560 

MSM00570 

MSM00580 

MSM00590 

MSM00600 

MSM00610 

MSM00620 

MSM00630 

MSM00640 


msml.for 

1  ETABEG (LATDIM, LTDIM, lEDIM) , ETABND (LTDIM, lEDIM, ITMDIM) , 

2  FLXBND{LTDIM,IEDIM, ITMDIM), 

3  BNDLOC (LTDIM, ITMDIM) , ALAM (lEDIM) , COLAT (LATDIM, LTDIM) , 

4  ALOCT (LATDIM, LTDIM) , BMIN (LATDIM, LTDIM) , XMIN (LATDIM, LTDIM) , 

5  YMIN (LATDIM, LTDIM) , ZMIN (LATDIM, LTDIM) , TIMTAG (ITMDIM) , 

6  ALMDEL(IEDIM) 

C 

DIMENSION  VNORTH (LATDIM, LTDIM) , VSOUTH (LATDIM, LTDIM) 

C 


DIMENSION  IFLAV (lEDIM) , BNDMAX (LTDIM) , 

1  ALPHA (LATDIM) , BETA (LATDIM) , BIR (LATDIM,  LTDIM) , 

2  ASOUTH (3, ITMDIM) , BSOUTH (3, ITMDIM) ,DXS (3, ITMDIM) , DYS (3, ITMDIM) , 

3  ANORTH (3, ITMDIM) ,BNORTH(3, ITMDIM) , DXN (3, ITMDIM) , DYN (3, ITMDIM) , 

4  VMLOSS (LATDIM, LTDIM, ITMDIM) , 

5  TETA (LATDIM) , PHI (LTDIM) , SINI (LATDIM, LTDIM) 

C 

DIMENSION  R (LATDIM, LTDIM, ITMDIM) , P (LATDIM, LTDIM, ITMDIM) 

C 

DIMENSION  SCTFRC (lEDIM, LTDIM, ITMDIM) , RPP (ITMDIM) 

C 


C 

C 

C 

C 


C 


DIMENSION  DKTIME (IRDK, INRGDK, ISOLDE,  lONDK) 

DIMENSION  ID (20) , RID (20) , THRSH (lEDIM) , ERSHFT (lEDIM) 


DIMENSION  AUGPAR(NAUGEL, ITMDIM) 

LOGICAL*!  MODE (NAUGEL, ITMDIM) 

DIMENSION  FLXMAT (IRDIM,NRGDIM, KPPLUS, ISPDIM) 
DIMENSION  THRMAT(IRDIM,NRGDIM,KPDIM) 

DIMENSION  FLXR(IRDIM) , FLXNRG (NRGDIM) , FLXKP (KPDIM) 


C 

C  CALL  PRECIPITATION  AND  PARTICLE  TRACER  CONTROL 

C 

C 

C  INPUT  MAJOR  TIME  STEP  INCREMENT  (YEARS,  DAYS,  SECONDS) 
IINC(I)  =  0 
IINC(2)  =  0 
IINC(3)  =  900 
C 

C  READ  IN  START  YEAR,  START  DAY,  START  TIME  IN  SECONDS 
READ (5,*)  lYEAR, IDAY,ISEC 
I START ( 1 ) =I YEAR- ( I YEAR/ 1 0  0 ) * 1 0  0 
ISTART(2)“IDAY 
I START (3) =I SEC 


C 

C  READ  IN  STOP  YEAR,  STOP  DAY,  STOP  TIME  IN  SECONDS 
READ (5,*)  lYEAR, IDAY,ISEC 
lEND ( 1 ) -I YEAR- ( I YEAR/ 1 0  0 ) *  1 0  0 
IEND(2)-IDAY 
IEND(3)“ISEC 
C 

C  READ  IN  START  RECORD  NUMBER 
READ (5,*)  IRECEB 
IRECPT=IRECEB 
C 

C  READ  IN  STRING  TO  IDENTIFY  RUN 
READ  (5,*)  CHID 
C 

C  READ  IN  SUN  SPOT  NUMBER  SSN 
READ(5,*)  SSN 
C 

WRITE (6,*)  ' ISTART=' , ISTART 


MSM00650 

MSM00660 

MSM00670 

MSM00680 

MSM00690 

MSM00700 

MSM00710 

MSM00720 

MSM00730 

MSM00740 

MSM00750 

MSM00760 

MSM00770 

MSM00780 

MSM00790 

MSM00800 

MSM00810 

MSM00820 

MSM00830 

MSM00840 

MSM00850 

MSM00860 

MSM00870 

MSM00880 

MSM00890 

MSM00900 

MSM00910 

MSM00920 

MSM00930 

MSM00940 

MSM00950 

MSM00960 

MSM00970 

MSM00980 

MSM00990 

MSMOIOOO 

MSMOlOlO 

MSM01020 

MSM01030 

MSM01040 

MSM01050 

MSM01060 

MSM01070 

MSM01080 

MSM01090 

MSMOllOO 

MSMOlllO 

MSM01120 

MSM01130 

MSM01140 

MSM01150 

MSM01160 

MSM01170 

MSM01180 

MSM01190 

MSM01200 

MSM012I0 

MSM01220 

MSM01230 

MSM01240 

MSM01250 

MSM01260 

MSM01270 

MSM01260 


ooo  ooooooooooooo  oooooooooooo 


WRITE (6, *) 
WRITE (6,*) 
WRITE (6,*) 
WRITE (6, *) 


'  IEND=' , lEND 
'IRECPT='  ,IRECPT, 
'CHID='  ,CHID 
'SSN=' ,SSN 


IRDBEG=IRECPT 


msml.for 

IRECEB=' , IRECEB 


C 

c 

C  INITIALIZE  TIMER 

C 

C  CALLS  TO  DTIME  ARE  PLACED  IN  THE  CODE  TO  PROVIDE  TIMING  INFORMATION 
C  FOR  DIFFERENT  SECTIONS  OF  THE  PROGRAM.  THE  DUMMY  SUBROUTINE  STUB 
C  DTIME  NEEDS  TO  BE  REPLACED  WITH  MACHINE-SPECIFIC  TIMING  CALLS  IN 
C  ORDER  TO  OBTAIN  REAL  TIMING  INFORMATION. 

C 

C  CALL  DTIME (ITODST) 

C 

C  CALL  TO  PPTCON  READS  AND  ASSIMILATES  AVAILABLE  INPUT  DATA,  PRODUCES 
C  E  AND  B  FIELD  MATRICES  FOR  PERIOD  OF  INTEREST,  AND  COMPUTES 

C  PARTICLE  FLUXES  IN  MAGNETOSPHERE  AND  PRECIPITATING  INTO 

C  IONOSPHERE . 

C 

CALL  PPTCON (I START, IINC, lEND, LATDIM, LTDIM, lEDIM, ITMDIM, 

1  IRDK, INRGDK, ISOLDK, lONDK, 

1  IRDIM, NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXR, FLXNRG, FLXKP, FLXMAT, 

2  THRMAT,CHID, ID, RID, SCTFRC, IFLAV, BNDMAX, ALPHA, BETA, TETA, PHI , BIR, 

3  S INI , TIMTAG , COLAT , ALOCT , V, VNORTH , VSOUTH , ASOUTH , BSOUTH , DXS , DYS , 

4  ANORTH, BNORTH, DXN, DYN, VM, VMLOSS, BMIN, XMIN, YMIN, ZMIN, 

5  ALAM, ETABEG, ETABND, FLXBND, BNDLOC, ETA, FLUX, EFLUX, FLXSUM, 

6  EAVG,R,P, 

7  ALMDEL, NAUGEL, AUGPAR, MODE, RPP, THRSH, ERSHFT,  DKTIME) 


FIND  TIME  TO  EXECUTE  PPTCON 


CALL  DTIME (IPPTIM) 

WRITE  (LUERR, *)  'THE  TIME  SPENT  IN  PPTCON  IS  ', 

1  ABS (IPPTIM-ITODST) /lOO. , '  SECONDS.' 

CALL  HIEPAR 

CALL  TO  HIEPAR  GIVES  THE  STATISTICS-BASED  HIGH  ENERGY  (>  300  KEV) 
OUTPUT  OF  THE  PROGRAM.  THE  JULY  1,  1990,  VERSION  OF  THE  MSM  FOR 
DELIVERY  TO  THE  AIR  FORCE  CONTAINS  ONLY  A  DUMMY  STUB  FOR  HIEPAR. 

CALL  HIEPAR 


FIND  TIME  TO  EXECUTE  HIEPAR 
CALL  DTIME (IHIETM) 

WRITE  (LUERR,*)  'THE  TIME  SPENT  IN  HIEPAR  IS  ', 

1  ABS (IHIETM-IPPTIM) /lOO. , '  SECONDS.' 

CALL  OUTPUT 

IN  THE  SFC  OPERATIONAL  VERSION  OF  THE  MSM,  THE  CALL  TO  OUTPUT 
WILL  OUTPUT  MSM  RESULTS  TO  THE  ENVIRONMENTAL  DATA  BASE. 

THE  JULY  1,  1990,  DELIVERY  VERSION  OF  THE  MSM  CONTAINS  A  STUB  FOR 
SUBROUTINE  OUTPUT. 

CALL  OUTPUT 

FIND  TIME  TO  EXECUTE  OUTPUT 
C  CALL  DTIME (lOUTIM) 

C  WRITE  (LUERR,*)  'THE  TIME  SPENT  IN  OUTPUT  IS  ', 

C  1  ABS (lOUTIM-IHIETM) /lOO. , '  SECONDS.' 


MSM01290 

MSM01300 

MSM01310 

MSM01320 

MSM01330 

MSM01340 

MSM01350 

MSM01360 

MSM01370 

MSM01380 

MSM01390 

MSM01400 

MSM01410 

MSM01420 

MSM01430 

MSM01440 

MSM01450 

MSM01460 

MSM01470 

MSM01480 

MSM01490 

MSM01500 

MSM01510 

MSM01520 

MSM01530 

MSM01540 

MSM01550 

MSM01560 

MSM01570 

MSM01580 

MSM01590 

MSM01600 

MSM01610 

MSM01620 

MSM01630 

MSM01640 

MSM01650 

MSM01660 

MSM01670 

MSM01680 

MSM01690 

MSM01700 

MSM01710 

MSM01720 

MSM01730 

MSM01740 

MSM01750 

MSM01760 

MSM01770 

MSM01780 

MSM01790 

MSM01800 

MSM01810 

MSM01820 

MSM01830 

MSM01840 

MSM01850 

MSM01860 

MSM01870 

MSM01880 

MSM01890 

MSM01900 

MSM01910 

MSM01920 


msml.for 


FIND  THE  TOTAL  TIME  OF  THE  RUN 


CALL  DTIME(ITODED) 

WRITE  (LUERR, *)  'THE  TOTAL  TIME  SPENT  IN  MSMCON  IS 
ABS (ITODED-ITODST) /lOO. , '  SECONDS. ' 


^  it  it  It  It  it -k  it  ic  it  ic  if  it  it  it  It  ±  ic  it  it  ii  it  "k  ic  It  ic 


SUBROUTINE  PPTCON (ISTART, IINC, lEND, LATDIM, LTDIM, lEDIM, ITMDIM, 

L  IRDK, INRGDK, ISOLDK, lONDK, 

L  IRDIM, NRGDIM, KPDIM, KPPLUS , ISPDIM, FLXR, FLXNRG, FLXKP , FLXMAT, 

>  THRMAT, CHID, ID, RID, SCTFRC, IFLAV, BNDMAX, ALPHA, 

}  BETA, TETA, PHI, BIR, SINI, TIMTAG,COLAT, 

1  ALOCT, V, VNORTH, VSOUTH, ASOUTH, BSOUTH, DXS, DYS, 

>  ANORTH, BNORTH, DXN, DYN, VM, VMLOSS, BMIN, XMIN, YMIN, 2MIN, 

)  ALAM, ETABEG, ETABND, FLXBND, BNDLOC, ETA, FLUX, EFLUX, FLXSUM, EAVG, 

1  R,P, 

}  ALMDEL, NAUGEL, AUGPAR, MODE, RPP, THRSH, ERSHFT, DKTIME) 


MSM01930 

MSM01940 

MSM01950 

MSM01960 

MSM01970 

MSM01980 

MSM01990 

MSM02000 

MSM02010 

MSM02020 

MSM02030 

MSM02040 

MSM02050 

MSM02060 

MSM02070 

MSM02080 

MSM02090 

MSM02100 

MSM02110 

MSM02120 

MSM02130 

MSM02140 

MSM02150 


c 

VERSION  1.1 

DATE: 

NOVEMBER 

23, 

1988 

MSM02160 

c 

1.2 

SEPTEMBER  8, 

1989 

MSM02170 

c 

1.3 

NOVEMBER 

17, 

1989 

MSM02180 

c 

1.4 

(APRIL,  1990  VERSION) 

MARCH 

26, 

1990 

MSM02190 

c 

1.5 

(JULY  1,  1990  VERSION) 

JULY 

01, 

1990 

MSM02200 

c 

MSM02210 

c 

PROGRAMMER: 

BRYAN  BALES/R.W.  SPIRO 

MSM02220 

PURPOSE:  THIS  EXECUTIVE  ROUTINE  CONTROLS  THE  ELECTRIC  AND  MAGNETIC 

FIELD  MODEL  (EBCON)  AND  THE  RUNNING  OF  THE  PARTICLE 
TRACE  ALGORITHM  (PPTM) . 

CALLING  PARAMETERS: 


ISTART 

IINC 

I  END 

LATDIM 

LTDIM 

lEDIM 

ITMDIM 

IRDK 

INRGDK 

ISOLDK 

lONDK 

IRDIM 

NRGDIM 

KPDIM 

KPPLUS 

ISPDIM 

FLXR 

FLXNRG 

FLXKP 

FLXMAT 


THRMAT 


START  YEAR,  DAY,  AND  TIME  (SEC) 

MAJOR  TIME  STEP  INCREMENT  (YEAR,  DAY,  TIME) 

ENDING  YEAR,  DAY,  AND  TIME  (SEC) 

NUMBER  OF  LATITUDINAL  GRID  SPACES 

NUMBER  OF  LOCAL  TIME  (LONGITUDINAL)  GRID  SPACES 

NUMBER  OF  PARTICLE  SPECIES  TO  BE  TRACED 

MAXIMUM  NUMBER  OF  MAJOR  TIME  STEPS  FOR  THIS  RUN 

R  DIMENSION  OF  DKTIME  ARRAY 

ENERGY  DIMENSION  OF  DKTIME  ARRAY 

SUN  SPOT  NUMBER  DIMENSION  OF  DKTIME  ARRAY 

NUMBER  OF  ION  SPECIES  IN  DKTIME  ARRAY 

R  DIMENSION  OF  FLXMAT  ARRAYS 

ENERGY  DIMENSION  OF  FLXMAT  ARRAYS 

NUMBER  OF  KP  VALUES  FOR  FLXMAT  ARRAYS 

AUGMENTED  KP  DIMENSION  OF  FLXMAT  (KPDIM+2) 

PLASMA  MASS  SPECIES  DIMENSION 

R  VALUES  AT  WHICH  FLXMAT  ARRAYS  ARE  CALCULATED 
ENERGY  VALUES  FOR  WHICH  FLXMAT  ARRAYS  ARE  CALCULATED 
KP  VALUES  FOR  WHICH  FLXMAT  ARRAYS  ARE  CALCULATED 
ARRAY  OF  EMPIRICAL  FLUXES  AS  FUNCTION  OF  R,  ENERGY, 
AND  KP  FOR  USE  IN  CALCULATING  INITIAL  AND  BOUNDARY 
FLUX  VALUES. (COMPUTED  IN  CALL  TO  FLXNIT) 

ARRAY  OF  EMPIRICAL  FLUXES  AS  FUNCTION  OF  R,  ENERGY, 
AND  KP  FOR  USE  AS  THRESHOLD  FLUXES  (COMPUTED  IN  CALL 
TO  FLXNIT) 

CHARACTER  HEADER  STRING  (UP  TO  80  CHARACTERS) 

INTEGER  HEADER  VECTOR 
ID(1)  =  YEAR 


MSM02230 

MSM02240 

MSM02250 

MSM02260 

MSM02270 

MSM02280 

MSM02290 

MSM02300 

MSM02310 

MSM02320 

MSM02330 

MSM02340 

MSM02350 

MSM02360 

MSM02370 

MSM02380 

MSM02390 

MSM02400 

MSM02410 

MSM02420 

MSM02430 

MSM02440 

MSM02450 

MSM02460 

MSM02470 

MSM02480 

MSM02490 

MSM02500 

MSM02510 

MSM02520 

MSM02530 

MSM02540 

MSM02550 

MSM02560 


msml.for 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


RID 


SCTFRC 

IFLiAV 


BNDMAX 

ALPHA 

BETA 

TETA 

PHI 

BIR 

SINI 

TIMTAG 

COLAT 

ALOCT 

V 

VNORTH 

VSOUTH 

ASOUTH, 


VM 

VMLOSS 

BMIN 

XMIN 


YMIN 

ZMIN 

ALAM 

ETABEG 

ETABND 

FLXBND 

BNDLOC 


ID  (2)  =  DAY 

ID (3)  -  HOURS 

ID (4)  =  MINUTES 

ID (5)  =  SECONDS 

ID (6)  =  PRESENTLY  UNUSED 

ID (7)  =  PRESENTLY  UNUSED 

ID (8)  =  FIRST  DIMENSION  OF  OUTPUT  ARRAY 

ID  (9)  =  SECOND  DIMENSION  OF  OUTPUT  ARRAY 

ID  (10)  =  THIRD  DIMENSION  OF  OUTPUT  ARRAY 

ID (11)  =  TIME  INDEX  L 

ID (12)  -  ID (20)  =  PRESENTLY  UNUSED 

REAL  HEADER  VECTOR 

RID(l)  =  TIMTAG 

RID  (2)  =  KP 

RID (3)  =  POLAR  CAP  POTENTIAL  DROP 
RID (4)  =  TIME  DERIVATIVE  OF  LOCATION  OF 

LOW-LATITUDE  EDGE  OF  AURORAL  PRECIPITATION 
RID (5)  -  RID (20)  =  PRESENTLY  UNUSED 
ASSUMED  PITCH  ANGLE  SCATTERING  EFFICIENCY 
CHEMICAL  SPECIES  IDENTIFIER 

1  MEANS  ELECTRONS 

2  MEANS  H+  IONS 

3  MEANS  0+  IONS 

MAXIMUM  I  VALUE  OF  MODEL  BOUNDARY  ALONG  EACH  LOCAL 
TIME  GRID  LINE  DURING  THE  DURATION  OF  THIS  RUN. 
LATITUDINAL  GRID  SPACING  VECTOR 
LONGITUDINAL  GRID  SPACING  VECTOR 

COLATITUDE  OF  I  GRID  LINES  (RADIANS)  (USED  ONLY  IN 
SUBROUTINE  RDGRID) 

NON-ROTATED  HOUR  ANGLE  OF  J  GRID  LINES  (USED  ONLY 
IN  SUBROUTINE  RDGRID) 

RADIAL  COMPONENT  OF  IONOSPHERIC  MAGNETIC  FIELD  (NT) 
SIN (MAGNETIC  FIELD  INCLINATION  ANGLE) 

VECTOR  GIVING  TIMES  AT  WHICH  E  AND  B  PARAMETERS  ARE 
CALCULATED 

GRID  COLATITUDE  ARRAY  (RADIANS) 

GRID  LOCAL  TIME  ARRAY  (RADIANS  EASTWARD  FROM  NOON) 
ELECTRIC  POTENTIAL  DISTRIBUTION  ON  GRID  (OUTPUT  FROM 
EBCON)  (AVERAGE  OF  VNORTH  AND  VSOUTH) 

NORTHERN  HEMISPHERE  ELECTRIC  POTENTIAL  DISTRIBUTION 
(OUTPUT  FROM  EBCON) 

SOUTHERN  HEMISPHERE  ELECTRIC  POTENTIAL  DISTRIBUTION 
(OUTPUT  FROM  EBCON) 

BSOUTH,  DSX,  DYS,  ANORTH,  BNORTH,  DXN,  DYN 

SPECIFICATIONS  OF  ELECTRIC  FIELD  MODEL  BOUNDAY 
ELLIPSES 

FLUX  TUBE  VOLUME  (OUTPUT  FROM  EBCON) 

GEOMETRIC  FACTOR  USED  IN  CALCULATING  PRECIPITATION 
LOSS 

EQUATORIAL  MAGNETIC  FIELD  STRENGTH  (NT) 

GSM  X  LOCATION  OF  WHERE  FIELD  LINE  GOING  THROUGH 
GRID  PT  CROSSES  THE  EQUATORIAL  (B-FIELD  MINIMUM) 
PLANE 

GSM  Y  LOCATION  OF  WHERE  FIELD  LINE  GOING  THROUGH 
GRID  PT  CROSSES  THE  EQUATORIAL  PLANE 
GSM  Z  LOCATION  OF  WHERE  FIELD  LINE  GOING  THROUGH 
GRID  PT  CROSSES  THE  (B-FIELD  MINIMUM)  PLANE 
ENERGY  INVARIANT  VECTOR 

INITIAL  FLUX  TUBE  CONTENT  DISTRIBUTION  EACH  TIME 
STEP 

BOUNDARY  FLUX  TUBE  CONTENT  DISTRIBUTION 
FLUX  VALUES  AT  BOUNDARY 

LOCATION  OF  OUTER  BOUNDARY  OF  DETAILED  PARTICLE 
TRACES 


MSM02570 

MSM02580 

MSM02590 

MSM02600 

MSM02610 

MSM02620 

MSM02630 

MSM02640 

MSM02650 

MSM02660 

MSM02670 

MSM02680 

MSM02690 

MSM02700 

MSM02710 

MSM02720 

MSM02730 

MSM02740 

MSM02750 

MSM02760 

MSM02770 

MSM02780 

MSM02790 

MSM02800 

MSM02810 

MSM02e20 

MSM02830 

MSM02840 

MSM02850 

MSM02860 

MSM02870 

MSM02880 

MSM02890 

MSM02900 

MSM02910 

MSM02920 

MSM02930 

MSM02940 

MSM02950 

MSM02960 

MSM02970 

MSM02980 

MSM02990 

MSM03000 

MSM03010 

MSM03020 

MSM03030 

MSM03040 

MSM03050 

MSM03060 

MSM03070 

MSM03080 

MSM03090 

MSM03100 

MSM03110 

MSM03120 

MSM03130 

MSM03140 

MSM03150 

MSM03160 

MSM03170 

MSM03180 

MSM03190 

MSM03200 


rHCVir)  HCNCO 


ETA 


FLUX 

EFLUX 

FLXSUM 

EAVG 

R 

P 

ALMDEL 

NAUGEL 

AUGPAR 

MODE 

RPP 

DKTIME 


msml.for 

FLUX  TUBE  CONTENT  ARRAY  (PARTICLES /UNIT  MAGNETIC 

FLUX) 

PARTICLE  FLUX  AT  GRID  PTS  (PARTICLES/CM**2/S) 
PRECIPITATING  ENERGY  FLUX  ARRAY 

TOTAL  PRECIPITATION  ENERGY  FLUX  ARRAY  (INTEGRATED 
OVER  SPECIES)  FOR  (1)  ELECTRONS  (2)  H+  &  (3)  0+ 
AVERAGE  PRECIPITATING  ELECTRON  ENERGY 
FOR  (1)  ELECTRONS  (2)  H+  AND  (3)  0+ 

ARRAY  GIVING  RADIAL  DISTANCE  OF  GRID  PTS  IN 
MAGNETOS PHERIC  EQUATORIAL  PLANE  (RE) 

ARRAY  GIVING  HOUR  ANGLE  (MEASURED  EASTWARD  FROM 

NOON  IN  RADIANS)  OF  GRID  PTS  IN  EQUATORIAL  PLANE 

WIDTH  OF  ENERGY  INVARIANT  CHANNELS 

DIMENSION  OF  INPUT  ARRAYS 

AUGMENTED  DATA  ARRAY  FOR  INPUT  VALUES 

LOGICAL  VARIABLE  TELLING  WHICH  INPUT  PARAMETERS  WE 

HAVE  VALUES  FOR 

NOMINAL  RADIUS  OF  PLASMAPAUSE  DEFINED  AS  DIPOLE 
MAPPING  OF  EQUATORWARD  EDGE  OF  AURORAL  ZONE  TO 
MAGNETOSPHERIC  EQUATORIAL  PLANE 

ARRAY  GIVING  CHARGE  EXCHANGE  DECAY  TIMES  (SECONDS) 
FOR  AN  ARRAY  OF  RADIAL  DISTANCES,  ENERGIES,  SUN  SPOT 
NUMBERS,  AND  SPECIES 


CHARACTER* 80  CHID 


C 


INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP, DST, DDST, 
EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 
GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 
STAND , PCP , DEQDT , I PATT 


COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR,  IPMIN, IPSEC,  KP,  DST, 
EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 
GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL,  SWDEN, TILTW, 
STAND, PCP, IPATT, DDST, DEQDT 


COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 
LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 
LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
COMMON  /MOVE/IBEG, ISTOP, JBEG, JSTOP, lEBEG, lEEND 
COMMON  /IRDREC/  IRECPT, IRECEB,  IRDBEG 

DIMENSION  ISTART (3) , IINC (3) , lEND (3) , ITIME (3)  , 

ETA (LATDIM, LTDIM, lEDIM) , EFLUX (LATDIM, LTDIM, lEDIM) , 
FLXSUM(LATDIM, LTDIM,3) , EAVG (LATDIM, LTDIM, 3) , 

FLUX (LATDIM, LTDIM, lEDIM) 

DIMENSION  VM (LATDIM, LTDIM, ITMDIM) , V (LATDIM, LTDIM, ITMDIM) , 

1  ETABEG (LATDIM, LTDIM, lEDIM) , ETABND (LTDIM, lEDIM, ITMDIM) , 

2  FLXBND (LTDIM, lEDIM, ITMDIM)  , 

3  ALAM (lEDIM) , COLAT (LATDIM, LTDIM) , TIMTAG (ITMDIM) , 

4  ALOCT (LATDIM, LTDIM) , BMIN (LATDIM, LTDIM) , XMIN (LATDIM, LTDIM) , 

5  YMIN (LATDIM, LTDIM) , ZMIN (LATDIM, LTDIM) , BNDLOC (LTDIM, ITMDIM) , 

6  ALMDEL (lEDIM) 

DIMENSION  IFLAV (lEDIM) , BNDMAX (LTDIM) , 

1  ALPHA (LATDIM) , BETA (LATDIM) , BIR (LATDIM, LTDIM) , 

2  ASOUTH (3, ITMDIM) , BSOUTH (3, ITMDIM) ,DXS (3, ITMDIM) ,DYS (3, ITMDIM) , 

3  AN0RTH(3, ITMDIM) ,BN0RTH(3, ITMDIM) ,DXN(3, ITMDIM) ,DYN(3, ITMDIM) , 

4  VMLOSS (LATDIM, LTDIM, ITMDIM) , 


> 

MSM03210 

MSM03220 

MSM03230 

MSM03240 

MSM03250 

MSM03260 

MSM03270 

MSM03280 

MSM03290 

MSM03300 

MSM03310 

MSM03320 

MSM03330 

MSM03340 

MSM03350 

MSM03360 

MSM03370 

MSM03380 

MSM03390 

MSM03400 

MSM03410 

MSM03420 

MSM03430 

MSM03440 

MSM03450 

MSM03460 

MSM03470 

MSM03480 

MSM03490 

MSM03500 

MSM03510 

MSM03520 

MSM03530 

MSM03540 

MSM03550 

MSM03560 

MSM03570 

MSM03580 

MSM03590 

MSM03600 

MSM03610 

MSM03620 

MSM03630 

MSM03640 

MSM03650 

MSM03660 

MSM03670 

MSM03680 

MSM03690 

MSM03700 

MSM03710 

MSM03720 

MSM03730 

MSM03740 

MSM03750 

MSM03760 

MSM03770 

MSM03780 

MSM03790 

MSM03e00 

MSM03810 

MSM03820 

MSM03830 

MSM03840 
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C 

c 

c 

c 


5  TETA (LATDIM) , PHI (LTDIM) , SINI (LATDIM, LTDIM) 


DIMENSION 

DIMENSION 

DIMENSION 

DIMENSION 

LOGICAL*! 


VNORTH (LATDIM, LTDIM) , VSOUTH (LATDIM, LTDIM) 

R (LATDIM, LTDIM, ITMDIM) , P (LATDIM, LTDIM, ITMDIM) 

SCTFRC (lEDIM, LTDIM, ITMDIM) , RPP (ITMDIM) 

AUGPAR (NAUGEL, ITMDIM) 

MODE (NAUGEL, ITMDIM) 


DIMENSION  IDGHV(2) ,ID(20) ,RID(20) , THRSH (lEDIM) 
DIMENSION  ERSHFT(IEDIM) 

DIMENSION  ITMNEWO)  ,IRESTR(3) 


DIMENSION  FLXMAT (IRDIM, NRGDIM, KPPLUS, ISPDIM) 
DIMENSION  THRMAT (IRDIM, NRGDIM, KPDIM) 

DIMENSION  FLXR( IRDIM) , FLXNRG (NRGDIM)  ,  FLXKP (KPDIM) 


DIMENSION  DKTIME (IRDK, INRGDK, ISOLDE, lONDK) 
DATA  TSHENG,TSHING  /100.0,50./ 


SET  UP  THE  GRID 


CALL  RDGRID (LATDIM, LTDIM, ALPHA, BETA, TETA,  PHI , COLAT, BIR,  SINI ) 

*****  WRITE  ALL  VALUES  COMPUTED  IN  RDGRID 

WRITE  (6,*)  'LATDIM  =  ', LATDIM 
WRITE  (6,*)  'LTDIM  =  ', LTDIM 
WRITE  (6,*)  'ALPHA  ',  ALPHA 

WRITE  (6,*)  'BETA  ',  BETA 

WRITE  (6,*)  'TETA  ',  TETA 

WRITE  (6,*)  'PHI  ',  PHI 

CALL  OUTP (COLAT, LATDIM, LTDIM, 1, LATDIM,  1,  3,  LTDIM,  3,0., 

'COLAT' , 6, 132) 

CALL  OUTP (BIR, LATDIM, LTDIM, 1 0 , LATDIM, 1,1, LTDIM, 1,0.,'  BIR'  ,  6, 
) 

CALL  OUTP (SINI, LATDIM, LTDIM, 10, LATDIM, 2, 3, LTDIM, 3,0., 

'SINI' , 6, 80) 


READ  TABLE  OF  CHARGE  EXCHANGE  DECAY  TIMES  FOR  USE  IN  COMPUTING 
ION  CHARGE  EXCHANGE  LOSS 

CALL  READDK (IRDK, INRGDK, ISOLDK, lONDK, DKTIME) 

WRITE  OUT  DECAY  TIMES 
DO  4  IR-1,IRDK 

ELVAL=l.+.5*FLOAT(IR) 

WRITE (6, 865)  ELVAL 

865  FORMAT (IX/ IX, 'L-VALUE  =  ',F5.2) 

DO  6  ION=l,2 

IF(ION.EQ.l)  WRITE(6,866) 

IF(ION.EQ.2)  WRITE(6,867) 

866  FORMAT (IX, 'H+  DECAY  TIMES:  (SECONDS)') 

867  FORMAT (IX, '0+  DECAY  TIMES:  (SECONDS)') 

WRITE (6, 868)  ( (DKTIME (IR,INRG,ISOL, ION) , INRG=1 , INRGDK) 

2  ISOL=l, ISOLDK) 

868  F0RMAT(13(1X,1PE9.3) ) 

6  CONTINUE 


MSM03850 
MSM03860 
MSM03870 
MSM03880 
MSM03890 
MSM03900 
MSM03910 
MSM03920 
MSM03930 
MSM03940 
MSM03950 
MSM03960 
MSM03970 
MSM03980 
MSM03990 
MSM04000 
MSM04010 
MSM04020 
MSM04030 
MSM04040 
MSM04050 
MSM04060 
MSM04070 
MSM04080 
MSM04090 
MSM04100 
MSM04110 
MSM04120 
MSM04130 
MSM04140 
MSM04150 
MSM04160 
MSM04170 
MSM04180 
MSM04190 
MSM04200 
MSM04210 
MSM04220 
MSM04230 
132MSM04240 
MSM04250 
MSM04260 
MSM04270 
MSM04280 
MSM04290 
MSM04300 
MSM04310 
MSM04320 
MSM04330 
MSM04340 
MSM04350 
MSM04360 
MSM04370 
MSM04380 
MSM04390 
MSM04400 
MSM04410 
MSM04420 
MSM04430 
MSM04440 
,  MSM04450 

MSM04460 
MSM04470 
MSM04480 
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4  CONTINUE 


SET  UP  TIME  INDEPENDENT  ENERGY  CHANNELS  TO  MODEL 

CALL  SETALM(ALAM, lEMAXjIEDIM, IFLAV,ALMDEL) 
lEEND-IEMAX 

WRITE  OUT  ENERGY  CHANNEL  INFORMATION 
DO  999  IE-1, lEMAX 

WRITE(6,*)  'IFLAV-',IFLAV(IE),'  ALAM-' , ALAM (IE) , 

2  '  ALMDEL-' ,AK‘!DEL{IE) 

THRSH(IE)=0.0 
I  CONTINUE 

INITIALIZE  MATRIX  OF  KP  DEPENDENT  DEFAULT  FLUXES 

CALL  FLXNIT (IRDIM, NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXR, FLXNRG, FLXKP, 
2  FLXMAT,THRMAT) 


SPECIAL  PRINTOUT  FOR  FLXMAT  AND  THRMAT 
DO  300  IR-1, IRDIM 

IF(IR.EQ.l)  RDIST-3. 

IF{IR.EQ.2)  RDIST-4, 

IF(IR.EQ.3)  RDIST-6,6 
IF{IR.EQ.4)  RDIST-13, 

DO  310  IKP-1, KPPLUS 
MYKP-IKP-1 

WRITE (6, 850)  RDIST,MYKP 

850  FORMAT  (IX, '  R-' ,  F6 . 2, 2X, '  KP-' ,  12,  /) 

WRITE (6,*)  'ELECTRONS' 

WRITE (6, 851) 

851  FORMAT (IX, 'LOG  ENERGY' , 5X, ' LOG  FLUX' , 5X, ' LOG  THRESHOLD') 


DO  320  INRG-1, NRGDIM 

WRITE (6, 852)  FLXNRG (INRG) , FLXMAT (IR, INRG, IKP, 1) , 
2  THRMAT (IR, INRG, IKP) 

852  FORMAT(F10.4,5X,F8.4,5X,F13.4) 

320  CONTINUE 

WRITE(6,853) 

853  FORMAT (IX/) 

WRITE (6,*)  'H+  IONS' 

DO  321  INRG-1, NRGDIM 

WRITE (6, 859)  FLXNRG (INRG) , FLXMAT (IR, INRG, IKP, 2) 
859  FORMAT(F10.4,5X,F8,4) 

321  CONTINUE 

WRITE (6,  853) 

WRITE (6,*)  '0+  IONS' 

DO  322  INRG-1, NRGDIM 

WRITE (6, 859)  FLXNRG (INRG) , FLXMAT (IR, INRG, IKP, 3) 

322  CONTINUE 

WRITE (6, 853) 

310  CONTINUE 


MSM04490 

MSM04500 

MSM04510 

MSM04520 

MSM04530 

MSM04540 

MSM04550 

MSM04560 

MSM04570 

MSM04580 

MSM04590 

MSM04600 

MSM04610 

MSM04620 

MSM04630 

MSM04640 

MSM04650 

MSM04660 

MSM04670 

MSM04680 

MSM04690 

MSM04700 

MSM04710 

MSM04720 

MSM04730 

MSM04740 

MSM04750 

MSM04760 

MSM04770 

MSM04780 

MSM04790 

MSM04800 

MSM04810 

MSM04820 

MSM04830 

MSM04840 

MSM04850 

MSM04860 

MSM04870 

MSM0488a 

MSM04890 

MSM04900 

MSM04910 

MSM04920 

MSM04930 

MSM04940 

MSM04950 

MSM04960 

MSM04970 

MSM04980 

MSM04990 

MSM05000 

MSM05010 

MSM05020 

MSM05030 

MSM05040 

MSM05050 

MSM05060 

MSM05070 

MSM05080 

MSM05090 

MSM05100 

MSM05110 

MSM05120 


o  o 


WRITE (6,*)  'ELECTRONS' 

WRITE (6,*)  'FLXMAT  ARRAYS  (IR, NRG, IKP) ;  IR=1  IS  3RE,  IR=2  IS  4RE' 
WRITE (6,*)  'IR=3  IS  6.6  RE,  IR=4  IS  13  RE;  NRG  CORRESPONDS  TO' 
WRITE (6,*)  'LOG  OF  ENERGY  IN  EV  RUNNING  FROM  10  EV  TO  10**8  EV' 
WRITE (6,*)  'ENERGY*  10 . ** ( (3+NRG) /4) ;  KP=IKP-1' 

WRITE (6,*)  'KP=0' 

CALL  OUTP (FLXMAT ( 1 , 1 , 1 , 1 ) , IRDIM, NRGDIM, 1 ,  IRDIM, 1 , 1 ,  NRGDIM,  1,0., 

2  'FLXMATl',6,132) 

WRITE (6,*)  'KP=1' 

CALL  OUTP (FLXMAT (1 , 1 , 2 , 1 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMATl',6,132) 

WRITE(6,*)  'KP=2' 

CALL  OUTP (FLXMAT ( 1 , 1 , 3 , 1 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMATl',6,132) 

WRITE (6,*)  'KP=3' 

CALL  OUTP (FLXMAT (1,1, 4,1), IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMATl',6,132) 

WRITE (6,*)  'KP=4' 

CALL  OUTP (FLXMAT ( 1 , 1 , 5 , 1 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMATl',6,132) 

WRITE (6,*)  'KP=5' 

CALL  OUTP (FLXMAT (1, 1, 6, 1) , IRDIM, NRGDIM, 1, IRDIM, 1, 1, NRGDIM, 1, 0 . , 

2  'FLXMATl',6,132) 

WRITE (6,*)  'KP=6' 

CALL  OUTP ( FLXMAT (1,1, 7,1), IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMATl',6,132) 

WRITE (6,*)  'MINIMA' 

CALL  OUTP (FLXMAT ( 1 , 1 , 8 , 1 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMATl',6,132) 

WRITE (6,*)  'MAXIMA' 

CALL  OUTP (FLXMAT ( 1 , 1 , 9 , 1 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMATl',6,132) 

WRITE (6,*)  'H+  IONS' 

WRITE (6,*)  'KP=0' 

CALL  OUTP (FLXMAT ( 1 , 1 , 1 , 2 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMAT2' , 6, 132) 

WRITE (6,*)  'KP=1' 

CALL  OUTP (FLXMAT ( 1 , 1 , 2 , 2 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMAT2' , 6, 132) 

WRITE (6,*)  'KP=2' 

CALL  OUTP (FLXMAT (1 , 1,3,2), IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMAT2' , 6, 132) 

WRITE (6,*)  'KP=3' 

CALL  OUTP (FLXMAT ( 1 , 1 , 4 , 2 ) , IRDIM, NRGDIM, 1 , IRDIM, 1 , 1 , NRGDIM, 1,0., 

2  'FLXMAT2' , 6, 132) 

WRITE(6,*)  'KP=4' 

CALL  OUTP (FLXMAT (1 , 1,5,2), IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMAT2' , 6, 132) 

WRITE (6,*)  'KP=5' 

CALL  OUTP (FLXMAT ( 1 , 1 , 6, 2 ) , IRDIM, NRGDIM, 1 ,  IRDIM,  1,1, NRGDIM,  1,0., 

2  'FLXMAT2',6,132) 

WRITE (6,*)  'KP=6' 

CALL  OUTP (FLXMAT (1,1, 7, 2), IRDIM, NRGDIM, 1 , IRDIM, 1 , 1 , NRGDIM, 1,0., 

2  'FLXMAT2' , 6, 132) 

WRITE (6,*)  'MINIMA' 

CALL  OUTP (FLXMAT ( 1 , 1 , 8, 2) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMAT2' , 6, 132) 

WRITE (6,*)  'MAXIMA' 

CALL  OUTP (FLXMAT ( 1 , 1 , 9, 2 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 

2  'FLXMAT2' ,6, 132) 

WRITE (6,*)  '0+  IONS' 


MSM05130 

MSM05140 

MSM05150 

MSM05160 

MSM05170 

MSM05180 

MSM05190 

MSM05200 

MSM05210 

MSM05220 

MSM05230 

MSM05240 

MSM05250 

MSM05260 

MSM05270 

MSM05280 

MSM05290 

MSM05300 

MSM05310 

MSM05320 

MSM05330 

MSM05340 

MSM05350 

MSM05360 

MSM05370 

MSM05380 

MSM05390 

MSM05400 

MSM05410 

MSM05420 

MSM05430 

MSM05440 

MSM05450 

MSM05460 

MSM05470 

MSM05480 

MSM05490 

MSM05500 

MSM05510 

MSM05520 

MSM05530 

MSM05540 

MSM05550 

MSM05560 

MSM05570 

MSM05580 

MSM05590 

MSM05600 

MSM05610 

MSM05620 

MSM05630 

MSM05640 

MSM05650 

MSM05660 

MSM05670 

MSM05680 

MSM05690 

MSM05700 

MSM05710 

MSM05720 

MSM05730 

MSM05740 

MSM05750 

MSM05760 
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c 

c 

c 

c 

c 

C 
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WRITE (6,*)  'KP=0' 

CALL  OUTP (FLXMAT ( 1 , 1 , 1 , 3 ) , IRDIM, NRGDIM, 1 , IRDIM,  1 , 1 , NRGDIM, 1,0., 

2  'FLXMAT3' , 6, 132) 

WRITE (6,*)  'KP-1' 

CALL  OUTP (FLXMAT ( 1 , 1 , 2 , 3 ) , IRDIM, NRGDIM, 1 , IRDIM, 1 , 1 , NRGDIM, 1,0., 

2  'FLXMAT3' , 6, 132) 

WRITE (6,*)  'KP=2' 

CALL  OUTP (FLXMAT (1, 1, 3,3), IRDIM, NRGDIM, 1, IRDIM, 1, 1, NRGDIM, 1, 0. , 
2  'FLXMAT3',6,132) 

WRITE (6,*)  'KP*3' 

CALL  OUTP (FLXMAT (1 , 1 , 4 , 3 ) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 


2  ' FLXMAT3 

WRITE (6,*)  'KP=4' 
CALL  OUTP (FLXMAT (1 
2  'FLXMAT3 

WRITE (6,*)  'KP=5' 
CALL  OUTP (FLXMAT (1 
2  'FLXMAT3 

WRITE (6,*)  'KP=6' 
CALL  OUTP (FLXMAT (1 
2  ' FLXMAT3 

WRITE (6,*)  'MINIMA 
CALL  OUTP (FLXMAT (1 
2  ' FLXMAT3 

WRITE (6,*)  'MAXIMA 
CALL  OUTP (FLXMAT (1 
2  ' FLXMAT 3 

CALL  OUTP(THRMAT(l 
2  'THRMATl 

CALL  OUTP(THRMAT(l 
2  ' THRMAT2 

CALL  OUTP  (THRMATd 
2  ' THRMAT3 

CALL  OUTP  (THRMATd 
2  ' THRMAT4 

CALL  OUTP  (THRMATd 
2  ' THRMAT5 

CALL  OUTP  (THRMATd 
2  ' THRMAT6 

CALL  OUTP (THRMAT (1 
2  '  THRMAT7 


,6,132) 

1.5.3) ,  IRDIM,  NRGDIM,  1,  IRDIM,  1, 1,  NRGDIM,  1,  0  .  , 
,6,132) 

1.6.3) , IRDIM, NRGDIM, 1, IRDIM, 1, 1, NRGDIM, 1, 0 . , 
,6,132) 

1.7.3) ,  IRDIM, NRGDIM, 1, IRDIM, 1 , 1 , NRGDIM, 1 , 0 . , 
,6,132) 

1.8.3) , IRDIM,  NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 
,6,132) 

1,  9, 3) , IRDIM, NRGDIM, 1, IRDIM, 1 , 1 , NRGDIM, 1 , 0 . , 
,6,132) 

1.1) ,  IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 
,6,80) 

1.2) ,  IRDIM,  NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 
,6,80) 

1.3) , IRDIM,  NRGDIM, 1,  IRDIM, 1, 1, NRGDIM, 1, 0 . , 
,6,80) 

1.4) , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 
,6,80) 

1 . 5 )  , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 
,6,80) 

1 . 6 )  , IRDIM, NRGDIM, 1 , IRDIM, 1,1, NRGDIM, 1,0., 
,6,80) 

1.7) ,  IRDIM,  NRGDIM,  1 ,  IRDIM,  1,1,  NRGDIM,  1,0., 
,6,80) 


GET  CURRENT  TIME 

CALL  DTIME(ISTEB) 

IRECST=MAX (1, IRECEB) 

CALL  TO  EBCON  COMPUTES  ALL  THE  ELECTRIC  AND  MAGNETIC  FIELD  MODELS 
NEEDED  FOR  THE  RUN 


call  EBCON (ISTART, I INC, lEND, COLAT, ALOCT, LATDIM, LTDIM, ITMDIM, 

1  lEDIM, NAUGEL, CHID, ID, RID, VM, BMIN, XMIN, YMIN, ZMIN, 

2  V, VNORTH, VSOUTH, ASOUTH, BSOUTH, DXS, DYS, 

3  ANORTH,BNORTH,DXN,DYN,BNDLOC, 

4  TIMTAG, ITMMAX, R, P, BIR, SINI, VMLOSS, SCTFRC, AUGPAR, MODE, 

5  RPP, IEMAX,TETA) 

GET  CURRENT  TIME  AND  FIND  TIME  SPENT  IN  EBCON 
C  CALL  DTIME(IENDEB) 

C  WRITE  (LUERR, *)  'THE  TIME  SPENT  IN  EBCON  IS  ', 

C  1  ABS(IENDEB-ISTEB) /lOO.,'  SECONDS.' 


MSM05770 

MSM05780 

MSM05790 

MSM05800 

MSM05810 

MSM05820 

MSM05830 

MSM05840 

MSM05850 

MSM05860 

MSM05870 

MSM05880 

MSM05890 

MSM05900 

MSM05910 

MSM05920 

MSM05930 

MSM05940 

MSM05950 

MSM05960 

MSM05970 

MSM05980 

MSM05990 

MSM06000 

MSM06010 

MSM06020 

MSM06030 

MSM06040 

MSM06050 

MSM0SC60 

MSM06070 

MSM06080 

MSM06090 

MSM06100 

MSM06110 

MSM06120 

MSM06130 

MSM06140 

MSM06150 

MSM06160 

MSM06170 

MSM06180 

MSM06190 

MSM06200 

MSM06210 

MSM06220 

MSM06230 

MSM06240 

MSM06250 

MSM06260 

MSM06270 

MSM06280 

MSM06290 

MSM06300 

MSM06310 

MSM06320 

MSM06330 

MSM06340 

MSM06350 

MSM06360 

MSM06370 

MSM06380 

MSM06390 

MSM06400 
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c 

C  COMPUTE  BNDMAX  FROM  BNDLOC 

C 

DO  8  LT=1,LTDIM 
BNDMAX (LT)=0. 

DO  9  ITM=1,ITMMAX 

IF (BNDLOC (LT,ITM) . GT . BNDMAX (LT) ) 

1  BNDMAX (LT)=BNDLOC(LT,ITM) 

9  CONTINUE 

8  CONTINUE 

C 
C 
C 
C 
C 
C 
C 

C  FIND  THE  TIME  DEPENDENDENT  PLASMA  BOUNDARY  CONDITION  FOR  PPTM 

C 

CALL  BNDSET (LATDIM, LTDIM, lEDIM, ITMDIM, ITMMAX, 

1  IRDIM, NRGDIM, KPDIM, KPPLUS , I SPDIM, FLXR, FLXNRG, FLXKP , FLXMAT, 

2  NAUGEL, TIMTAG, BNDLOC, IFLAV, AUGPAR, R, P, VM, ETA, ETABND, 

3  FLXBND,ALAM,ALMDEL,IEMAX) 

C 

C 

CALL  OUTP ( FLXBND (1,1,1), LTDIM, lEDIM, 3 , LTDIM, 1,1, lEMAX, 1 , 

2  0.,'FLXBND(J,IE,1)',6,132) 

C 

C 

C 

IF ( IRECPT . EQ . 0 ) THEN 
AZERO“ . 2 
BZERO-0 . 

CZERO=0 . 

ELSE 


C 

c 


c 

c 

c 


c 


c 


c 


c 

c 

c 


READ  START  FLUX  FROM  DATA  SET 
IRECMX=ABS (IRECPT) 

IRDFLX- (IRECMX-1) ‘IEMAX+1 

CALL  RDHDR(LUFLX, 'AFLX  ' , IRDFLX, ID, RID, CHID, 
2  LATDIM, LTDIM, ITMDIM) 

CHECK  IF  TIME  IS  CORRECT 


ISEC-ID(3) *3600+ID(4) *60+ID(5) 
IF(ID(1) .NE.ISTART(l) .OR. 

1  ID(2) .NE.ISTART(2) .OR. 

2  ISEC.NE.ISTART(3) )  THEN 


WRITE (6,*) 
WRITE (6,*) 
WRITE (6, *) 
WRITE(6, *) 


'START  TIME  DOES  NOT  MATCH  ETABEG  START  TIME' 
'STOPPING  PROGRAM  IN  PPTCON' 

' ISTART=' , I START 
'  ISEC-'  ,  ISEC, ' IRECMX=' , IRECMX 


STOP 
END  IF 


CALL  READ3D (LUFLX, 'AFLX  ', IRECMX, LATDIM, LTDIM, lEMAX, ITMDIM, 
1  ID,  RID, CHID, FLUX) 


CONVERT  FROM  PARTICLE  FLUX  TO  INVARIANT  FLUX  ETA 


CALL  FLX2ET (LATDIM, LTDIM, lEDIM, lEMAX, ITMDIM, 1 , IFLAV, ALAM, 
2  ALMDEL,BNDLOC,VM, FLUX, ETA) 


MSM06410 

MSM06420 

MSM06430 

MSM06440 

MSM06450 

MSM06460 

MSM06470 

MSM06480 

MSM06490 

MSM06500 

MSM06510 

MSM06520 

MSM06530 

MSM06540 

MSM06550 

MSM06560 

MSM06570 

MSM06580 

MSM06590 

MSM06600 

MSM06610 

MSM06620 

MSM06630 

MSM06640 

MSM06650 

MSM06660 

MSM06670 

MSM06680 

MSM06690 

MSM06700 

MSM06710 

MSM06720 

MSM06730 

MSM06740 

MSM06750 

MSM06760 

MSM06770 

MSM06780 

MSM06790 

MSM06800 

MSM06810 

MSM06820 

MSM06830 

MSM06840 

MSM06850 

MSM06860 

MSM06870 

MSM06880 

MSM06890 

MSM06900 

MSM06910 

MSM06920 

MSM06930 

MSM06940 

MSM06950 

MSM06960 

MSM06970 

MSM06980 

MSM06990 

MSM07000 

MSM07010 

MSM07020 

MSM07030 

MSM07040 


oo  ooo  ooo  oooooo  non 


msml.for 


AZERO=0 . 

BZERO« . 2 
CZERO=0 . 

END  IF 

IRECPT=MAX (1 , IRECPT) 
LL-1 


INITIALIZE  PLASMA  DISTRIBUTION 


CALL  INITAL (LL, LATDIM, LTDIM, lEDIM, ITMDIM, IRDIM, 

2  NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXR, FLXNRG, FLXKP, 

3  FLXMAT, IFLAV, AUGPAR (KP , LL) , R, P, VM, ETA, ETABEG, ALAM, ALMDEL, 

4  BNDLOC,AZERO,BZERO,CZERO,IEMAX) 


CONVERT  ETABEG  TO  FLUX  AND  WRITE  OUT  TO  DISK  FILE 

CALL  ET2FLX (LATDIM, LTDIM, lEDIM, lEMAX, ITMDIM, 1 , IFLAV, ALAM, 

2  ALMDEL, BNDLOC,VM, FLUX, ETABEG) 

ID(1)-ISTART(1) 

ID(2)-ISTART(2) 

ID{3)-ISTART(3) /3600 
ID(4)-MOD(ISTART(3) ,3600) /60 
ID(5)-MOD(ISTART(3) , 60) 

ID(11)-1 
ID (8) -LATDIM 
ID (9) -LTDIM 
ID(10)-IEMAX 

CALL  WRT3D (LUFLX, IRECPT, ID, RID, CHID, FLUX, LATDIM, LTDIM, lEMAX, 
2  ITMDIM) 


DO  400  KK-1,IEMAX 

WRITE (6,*)  'KK=  ',KK 

CALL  OUTP (ETABEG (1 , 1 , KK) , LATDIM, LTDIM, 20, 45,1,3, LTDIM-1 , 
2  1, 0. , 'ETABEG  (KK) ', 6, 132) 

WRITE (6,*)  'KK-' ,KK, 'BEGINNING  FLUX' 

CALL  OUTP (FLUX (1, 1, KK) , LATDIM, LTDIM, 20, 45, 1 , 3, LTDIM-1 , 

2  1,0.,'FLUX(KK)',6,132) 

400  CONTINUE 


ITIME(l)  -  ISTART(l) 

ITIME(2)  -  ISTART(2) 

ITIME(3)  -  ISTART(3) 

C 

C 

C 

C 

C 

C  FOLLOWING  IS  THE  MAIN  TIME  LOOP  IN  THE  PROGRAM 

C  LOOP  OVER  ALL  TIMES  IN  TIMTAG  (L=l  CORRESPONDS  TO  INITIAL  TIME) 
DO  10  L-2,ITMMAX 
IRECPT-IRECPT+1 
TSTART-TIMTAG(L) 

TSTOP-TIMTAG(L-l) 

PSTEP-TSTART-TSTOP 

WRITE (6,*)  '  L-  ',L, '  IRECPT-  ', IRECPT, ' TSTART-  ' , TSTART 


MSM07050 

MSM07060 

MSM07070 

MSM07080 

MSM07090 

MSM07100 

MSM07110 

MSM07120 

MSM07130 

MSM07140 

MSM07150 

MSM07160 

MSM07170 

MSM07180 

MSM07190 

MSM07200 

MSM07210 

MSM07220 

MSM07230 

MSM07240 

MSM07250 

MSM07260 

MSM07270 

MSM07280 

MSM07290 

MSM07300 

MSM07310 

MSM07320 

MSM07330 

MSM07340 

MSM07350 

MSM07360 

MSM07370 

MSM07380 

MSM07390 

MSM07400 

MSM07410 

MSM07420 

MSM07430 

MSM07440 

MSM07450 

MSM07460 

MSM07470 

MSM07480 

MSM07490 

MSM07500 

MSM07510 

MSM07520 

MSM07530 

MSM07540 

MSM07550 

MSM07560 

MSM07570 

MSM07580 

MSM07590 

MSM07600 

MSM07610 

MSM07620 

MSM07630 

MSM07640 

MSM07650 

MSM07660 

MSM07670 

MSM07680 


onn  noooo  o  oooo  o  oo 


msml.for 

WRITE (6,*)  '  TSTOP=  ',TSTOP,'  PSTEP=  ' , PSTEP, ' ITMMAX=' , ITMMAX 

CALL  OUTP (ETABND (1, 1, L) , LTDIM, lEDIM, 3, LTDIM, 1 , 1 , lEMAX, 1 , 

0. , 'ETABND(J, IE,L) ' , 6, 132) 


DTNOM=-bOO. 

IF(ABS (DTNOM) .GT.PSTEP)  DTNOM=-PSTEP 


LL=L 


IMODE=0 

IF (MODE (KP, L) .AND.IMODE.EQ.O)  THEN 

PERFORM  FULL  PARTICLE  TRACES 


GET  THE  CURRENT  TIME 

CALL  DTIME (ISTPPT) 

CALL  PPTM (TSTART, TSTOP, DTNOM, SCTFRC, IFLAV, BNDMAX, ALPHA, BETA, 

1  BIR, ITMMAX, LATDIM, LTDIM, lEDIM, ITMDIM, IRDIM, NRGDIM, KPDIM, 

2  KPPLUS, ISPDIM, FLXR, FLXNRG, FLXKP, FLXMAT, THRMAT, TIMTAG, ALAM, 

2  ALMDEL, VM, R, P, VMLOSS, V, ETABEG, ETABND, BNDLOC, ETA, EFLUX, 

3  FLXSUM, EAVG, LL, RPP, AUGPAR (KP, LL) , lEMAX. THRSH, TSHENG, 

4  TSHING, IRDK, INRGDK, ISOLDK, lONDK, DKTIME) 

GET  THE  CURRENT  TIME  AND  FIND  THE  TIME  SPENT  IN  PPTM 


C 

C 

c 


CALL  DTIME (lENPPT) 

WRITE (LUERR, *) '  THE  TIME  SPENT  IN  PPTM  IS  ', 

ABS (lENPPT-ISTPPT) /lOO. , '  SECONDS. ' 


C 

C  CALL  PWRCAL  TO  ESTIMATE  ELECTRON  PRECIPITATION  POLEWARD  OF  MAIN 
C  MSM  MODELING  REGION 
C 

CALL  PWRCAL (LATDIM, LTDIM, 3, ITMDIM, LL, AUGPAR (KP, LL) , FLXSUM, 

2  EAVG, COLAT,ALOCT, ALPHA, BETA, BNDLOC, ANORTH, 

3  BNORTH,DXN,DYN) 

C 

WRITE (18,*)'  TIME  =  ', TIMTAG (LL) 

WRITE (6,*)'  TIME  =  ', TIMTAG (LL) 


C 

C  USE  EMPIRICAL  FLXMAT  DENSITIES 
C 

C  CALL  DTIME (ISTFLX) 

C 


CALL  FLXDFL (LL, AUGPAR (KP, LL) , R, P, ALAM,  VM, IRDIM,  NRGDIM, 

1  KPDIM, KPPLUS, ISPDIM, FLXMAT, FLXR, FLXNRG, FLXKP, EFLUX, ETA, 

2  ALMDEL, LATDIM, LTDIM, lEDIM, ITMDIM, BNDLOC, lEMAX, IFLAV, 

3  1,IEMAX) 

C 

DO  998  IDO=l,IEMAX 
IF (IFLAV (IDO) .EQ. 1)  THEN 
THRSH (IDO) «TSHENG 
ELSE 

THRSH (IDO) =TSHING 
END  IF 

998  CONTINUE 

C 


MSM07690 

MSM07700 

MSM07710 

MSM07720 

MSM07730 

MSM07740 

MSM07750 

MSM07760 

MSM07770 

MSM07780 

MSM07790 

MSM07800 

MSM07810 

MSM07820 

MSM07830 

MSM07840 

MSM07850 

MSM07860 

MSM07870 

MSM07880 

MSM07890 

MSM07900 

MSM07910 

MSM07920 

MSM07930 

MSM07940 

MSM07950 

MSM07960 

MSM07970 

MSM07980 

MSM07990 

MSM08000 

MSM08010 

MSM08020 

MSM08030 

MSM08040 

MSM08050 

MSM08060 

MSM08070 

MSM08080 

MSM08090 

MSM08100 

MSM08110 

MSM08120 

MSM08130 

MSM08140 

MSM08150 

MSM08160 

MSM08170 

MSM08180 

MSM08190 

MSM08200 

MSM08210 

MSM08220 

MSM08230 

MSM08240 

MSM08250 

MSM08260 

MSM08270 

MSM08280 

MSM08290 

MSM08300 

MSM08310 

MSM08320 


oo  o  ooo  oooo  ooooonoooooo  ooo 


msml.for 

CALL  DTIMEdNDFLX) 

WRITE (LUERR, *) '  THE  TIME  SPEND  IN  FLXDFL  IS 
ABS (INDFLX-ISTFLX) /lOO. , '  SECONDS. ' 

CALL  DTIME (ISTAUR) 

ENDIF 


CALL  TO  AURL2S  PRODUCES  HARDY  ION  PRECIPITATION  MODEL 

CALL  AURL2S (AUGPAR{KP, L) , COLAT, ALOCT, LATDIM, LTDIM, 
1  FLXSUM(1,1»2) ,EAVG(1,1»2) ) 

CALL  OUTP  (FLXSUMd,  1, 2)  ,  LATDIM,  LTDIM,  15,  LATDIM,  1,3 
1  LTDIM, 1,0.,'IFLXSUM',6,132) 

CALL  DTIME (lENAUR) 

WRITE(LUERR, *) '  THE  TIME  SPENT  IN  AURL  IS  ', 

1  ABS(IENAUR-ISTAUR)/100.,'  SECONDS.' 


WRITE (6,*)  'T=',TSTART 

CONVERT  TSTOP  TO  3  VALUED  TIME  AND  PUT  IT  INTO  ITIME 
GET  ALOCT  AT  TSTOP 

ITIME (3)  =  ITIME (3)  +  INT(PSTEP) 

11  CONTINUE 

IF  (ITIME(3) .GT. 86400)  THEN 
ITIME (2)  =  ITIME (2)  +  1 
ITIME (3)  =  ITIME (3)  -  86400 

IF  (MOD(ITIME(l) ,4) . NE . 0 . AND . ITIME (2) .GT.365) 
ITIME (2)  =  ITIME (2)  -  365 
ITIME(l)  *  ITIME(l)  +  1 
ELSEIF  (MOD (ITIME (1) ,4) . EQ. 0 . AND . ITIME (2) .GT. 
ITIME (2)  =  ITIME (2)  -  366 
ITIME (1)  =  ITIME (1)  +  1 
END  IF 
GO  TO  11 
END  IF 

- >  WRITE  FLUX,  E’^LUX,  FLXSUM,  EAVG 

- >  TO  ARCHIVAL  FILES 

DO  2  IND=1,20 
ID(IND)-0 
RID(IND)=0. 

2  CONTINUE 

WRITE (6, *)  'L=',L, 'ITIME=',ITIME(3) 

ID (1) -ITIME (1) 

ID(2)-ITIME(2) 

ID(3)-ITIME(3) /3600 

ID (4) -MOD (ITIME (3) ,3600) / 60 

ID  (5) -MOD  (ITIME  (3)  ,  60) 

ID(11)=L 

- >  WRITE  FLXBND  TO  ARCHIVE  FILE 

ID (8) -LTDIM 
ID(9)-IEDIM 
ID(10)-1 


CALL  WRT3D  -.LUFLXB,  IRECPT,  ID,  RID,  CHID,  FLXBND  (1 , 1 ,  L)  ,  LTDIM,  lEDIM, 
2  1,ITMDIM) 


MSM08330 
MSM08340 
MSM08350 
MSM08360 
MSM08370 
MSM08380 
MSM08390 
MSM08400 
MSM08410 
MSM08420 
MSM08430 
MSM08440 
MSM08450 
MSM08460 
MSM08470 
MSM08480 
MSM08490 
MSM08500 
MSM08510 
MSM08520 
MSM08530 
MSM08540 
MSM08550 
MSM08560 
MSM08570 
MSM08580 
MSM08590 
MSM08600 
MSM08610 
THEN  MSM08620 
MSM08630 
MSM08640 
366)  THENMSM08650 
MSM08660 
MSM08670 
MSM08680 
MSM08690 
MSM08700 
MSM08710 
MSM08720 
MSM0873C 
MSM08740 
MSM08750 
MSM08760 
MSM08770 
MSM08780 
MSM08790 
MSM08800 
MSM08810 
MSM08820 
MSM08830 
MSM08840 
MSM08850 
MSM08860 
MSM08870 
MSM08880 
MSM08890 
MSM08900 
MSM08910 
MSM08920 
MSM08930 
MSM08940 
MSM08950 
MSM08960 


noo  o  no  ooo  oo  ooo  non  a  n  n  n 


msml.for 


ID(8)=LATDIM  MSM08970 

ID(9)=LTDIM  MSM08980 

ID(10)=1  MSM08990 

MSM09000 

MSM09010 

- >  WRITE  EAVG  AND  FLXSUM  TO  ARCHIVE  FILES  MSM09020 

MSM09030 

CALL  WRT3D (LUEAVG, IRECPT, ID, RID, CHID, EAVG, LATDIM, LTDIM, 1, ITMDIM)  MSM09040 
CALL  WRT3D (LUFLSM, IRECPT, ID, RID, CHID, FLXSUM, LATDIM, LTDIM, 1 , ITMDIM) MSM09050 
CALL  WRT3D (LUPIFX, IRECPT, ID, RID, CHID, FLXSUM (1 , 1,2), LATDIM, LTDIM,  MSM09060 


- >  WRITE  EAVG  AND  FLXSUM  TO  ARCHIVE  FILES 


2  1, ITMDIM) 

CALL  WRT3D (LUPIEN, IRECPT, ID, RID, CHID, EAVG (1 , 1, 2) , LATDIM, LTDIM, 
2  1, ITMDIM) 

- >  WRITE  FLUX  AND  EFLUX  TO  ARCHIVE  FILES 

ID(8)=LATDIM 

ID(9)=LTDIM 

ID(10)«=IEMAX 

CONVERT  ETA  TO  FLUX  FOR  OUTPUT 

CALL  ET2FLX (LATDIM, LTDIM, lEDIM,  lEMAX, ITMDIM, L, IFLAV, ALAM, 

2  ALMDEL,BNDLOC,VM, FLUX, ETA) 


CALL  WRT3D (LUFLX, IRECPT, ID, RID, CHID, FLUX, LATDIM, LTDIM, lEMAX, 

1  ITMDIM) 

CALL  WRT3D (LUEFLX, IRECPT, ID, RID, CHID, EFLUX, LATDIM, LTDIM, lEMAX, 
1  ITMDIM) 


IUT=100*ID(3)+ID(4) 
DO  111  IE=1,IEMAX 


MSM09070 

MSM09080 

MSM09090 

MSM09100 

MSM09110 

MSM09120 

MSM09130 

MSM09140 

MSM09150 

MSM09160 

MSM09170 

MSM09180 

MSM09190 

MSM09200 

MSM09210 

MSM09220 

MSM09230 

MSM09240 

MSM09250 

MSM09260 

MSM09270 

MSM09280 

MSM09290 


WRITE(6,*)  'IE=',IE,'  ALAM(1E)=' ,ALAM(IE) , '  SPEC1ES=' , IFLAV (IE) ,  MSM09300 


1  'L=',L,'  DAY=',ID(2) ,'  ITIME=',ITIME(3),'UT=',IUT 

CALL  OUTP ( ETA ( 1 , 1 , IE ) , LATDIM, LTDIM, 15,45,1,3, LTDIM, 1,0., 

1  'ETA', 6, 132) 

CALL  OUTP (FLUX ( 1 , 1 , IE) , LATDIM, LTDIM, 15,45,1, 3, LTDIM, 1,0., 

1  'FLUX', 6, 132) 

111  CONTINUE 

CALL  OUTP (ALOCT, LATDIM, LTDIM, 10,11,1,3, LTDIM, 1,0., 

1  'ALOCT' ,6,132) 

WRITE (6, *)  ' L=' ,L, 'DAY=' , ID (2) , 'UT=' , lUT, ' ITIME=' , ITIME (3) 
CALL  OUTP (FLXSUM, LATDIM, LTDIM, 15, 55,1,3,  LTDIM,  1,0., 

1  'FLXSUM' , 6, 132) 

WRITE (6, * )  ' L=' , L, ' DAY=' , ID (2) , ' UT=' , lUT, ' ITIME=' , ITIME (3) 
CALL  OUTP (EAVG, LATDIM, LTDIM, 15, 55, 1, 3, LTDIM, 3,0., 

1  'EAVG' , 6, 132) 

COPY  CURRENT  VALUES  IN  ETA  TO  ETABEG 

DO  20,  1=1,  LATDIM 
DO  30,  J=l,  LTDIM 
DO  40,  K-1,  lEMAX 

ETABEGd,  J,K)  =  ETA(I,J,K) 

10  CONTINUE 

50  CONTINUE 

>0  CONTINUE 

10  CONTINUE 

CALL  OPTERR (ETA, VM, LATDIM, LTDIM, lEDIM, lEMAX, ALAM, ALMDEL, THRSH, 
1  ITMDIM, IFLAV, ISTART, lEND, R, P, TIMTAG, ITMMAX, ERSHFT) 


MSM09310 

MSM09320 

MSM09330 

MSM09340 

MSM09350 

MSM09360 

MSM09370 

MSM09380 

MSM09390 

MSM09400 

MSM09410 

MSM09420 

MSM09430 

MSM09440 

MSM09450 

MSM09460 

MSM09470 

MSM09480 

MSM09490 

MSM09500 

MSM09510 

MSM09520 

MSM09530 

MSM09540 

MSM09550 

MSM09560 

MSM09570 

MSM09580 

MSM09590 

MSM09600 


msml.for 


RETURN 


it -k -k  it  "k  it  ii  it  it  it  it -k -k  ii -kic  it  it  It  it  if  if  ic  if  it  if -k  Ic  3  0  K 


kkkkkkkkkkkkkkkkkkkkkkkkkkk 


SUBROUTINE  EBCON (ISTART, UNO, lEND, COLAT, ALOCT, LATDIM, LTDIM, ITMDIM, 

1  lEDIM, NAUGEL, CHID, ID, RID, VM, BMIN, XMIN, YMIN, ZMIN, V, WORTH, 

2  VSOUTH, ASOUTH, BSOUTH, DXS, DYS, ANORTH, BNORTH, DXN, DYN, BNDLOC, 

3  TIMTAG, ITMMAX, R, P, BIR, SINI , VMLOSS, SCTFRC, AUGPAR, MODE, RPP, 

4  IEMAX,TETA) 


VERSION  1.1 


DATE:  FEBRUARY  5,  1988 
09.12.89 


PROGRAMMER:  BRYAN  A.  BALES/R.W.  SPIRO 

PURPOSE:  EBCON  CALLS  ROUTINES  TO  CALCULATE  THE  ELECTRIC  AND  THE 

MAGNETIC  FIELD  AT  OUR  GRID  POINTS. 


CHARACTER* 80  CHID 


INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN,  IPSEC, KP,  DST,  DDST, 
EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 

GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND,  SWVEL,  SWDEN,  TILTW, 

STAND, PCP,DEQDT, IPATT 

COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP, DST, 
EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 

GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

STAND, PCP, IPATT, DDST, DEQDT 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 
LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 
LUCOLT,  LUBNDL,  LUPDAT,  LUW,  LUVS,  LIONEG,  LIONNO,  LUENCH 

COMMON  /IRDREC/  IRECPT, IRECEB,  IRDBEG 

DIMENSION  AUGPAR (NAUGEL, ITMDIM) 

DIMENSION  ISTART (3) , IINC(3) , IEND{3) , ITIME(3)  , 

ITMNEW (3) ,VM (LATDIM, LTDIM, ITMDIM) ,V (LATDIM, LTDIM, ITMDIM) , 

BMIN (LATDIM, LTDIM) , XMIN (LATDIM, LTDIM) , TIMTAG (ITMDIM) , 

YMIN (LATDIM, LTDIM) , ZMIN (LATDIM, LTDIM) , 

COLAT (LATDIM, LTDIM) , ALOCT (LATDIM,  LTDIM) 

DIMENSION  WORTH (LATDIM, LTDIM) ,  VSOUTH (LATDIM, LTDIM) 

DIMENSION  TETA (LATDIM) 

DIMENSION  BNDLOC (LTDIM, ITMDIM)  , 

ASOUTH (3, ITMDIM) , BSOUTH (3, ITMDIM) , DXS (3, ITMDIM) , DYS (3, ITMDIM) , 
ANORTH (3, ITMDIM) , BNORTH (3, ITMDIM), DXN (3,  ITMDIM) , DYN (3, ITMDIM) , 
BIR (LATDIM, LTDIM) , SINI (LATDIM, LTDIM)  , 

VMLOSS (LATDIM, LTDIM, ITMDIM) , SCTFRC (lEDIM, LTDIM, ITMDIM) , 

RPP (ITMDIM) 

DIMENSION  R (LATDIM, LTDIM, ITMDIM) , P (LATDIM, LTDIM, ITMDIM) 
LOGICAL*!  MODE (NAUGEL, ITMDIM) 

DIMENSION  ID (20), RID (20) 

ITIME(IYEAR)  *  ISTART (lYEAR) 


MSM09610 

MSM09620 

MSM09630 

MSM09640 

MSM09650 

MSM09660 

MSM09670 

MSM09680 

MSM09690 

MSM09700 

MSM09710 

MSM09720 

MSM09730 

MSM09740 

MSM09750 

MSM09760 

MSM09770 

MSM09780 

MSM09790 

MSM09800 

MSM09810 

MSM09820 

MSM09830 

MSM09840 

MSM09850 

MSM09860 

MSM09870 

MSM09880 

MSM09890 

MSM09900 

MSM09910 

MSM09920 

MSM09930 

MSM09940 

MSM09950 

MSM09960 

MSM09970 

MSM09980 

MSM09990 

MSMIOOOO 

MSMIOOIO 

MSM10020 

MSM10030 

MSM10040 

MSM10050 

MSM10060 

MSM10070 

MSM10080 

MSM10090 

MSMIOIOO 

MSMIOIIO 

MSM10120 

MSM10130 

MSM10140 

MSM10150 

MSM10160 

MSM10170 

MSM10180 

MSM10190 

MSM10200 

MSM10210 

MSM10220 

MSM10230 

MSM10240 


onoo  oooo  ooo  o  ooooooooo  o  ooooo  on  oo 


ITIME(IDAY)  = 
ITIME(ISECND) 


msml.for 

ISTART(IDAY) 

=  ISTART(ISECND) 


PI-ATAN2(0.,-1.) 

INITIALIZE  ID  ARRAYS 
DO  4  IC=1,20 
ID(IC)=0 
RIDdO'O. 

4  CONTINUE 

FECON  RETURNS  TIME -DEPENDENT  INPUT  PARAMETERS 
CALL  DTIME(ISTFE) 

CALL  FECONdSTART,  IINC,  lEND,  ITMDIM,  NAUGEL,  MODE,  AUGPAR, 
2  ITMMAX,TIMTAG) 

WRITE  (6,*)  'ITMMAX  =  '  ,  ITMMAX 
DO  101,  1=1,  ITMMAX 

WRITE  (6,  800)  I,TIMTAGd) 

101  CONTINUE 

800  FORMAT  ('  TIMTAG ( ' , 12 . 2, ' )  =  ',F15.1) 

GET  THE  CURRENT  TIME  AND  FIND  THE  TIME  SPENT  IN  FECON 
CALL  DTIMEdENDFE) 

WRITE  (LUERR,*)  'THE  TIME  SPENT  IN  FECON  IS  ', 

1  ABS (lENDFE-ISTFE) /lOO. , '  SECONDS.' 


BEGINNING  OF  EB  TIME  LOOP 
IRECEB=MAX (1, IRECEB) 

IRECEB=IRECEB-1 

DO  10  IT-1, ITMMAX 
L  =  IT 

IRECEB-IRECEB+1 
SET  ALOCT  TO  CORRECT  VALUE 

CALL  MLTSETdTIMEdSECND)  ,  LATDIM,  LTDIM,  ALOCT) 

CALCULATE  SCTFRC  ARRAY  =  FRACTION  OF  STRONG  PITCH  ANGLE  SCATTERING 


FKP-AUGPAR(KP,L) 

CALL  SETSCT (L, ITIME (ISECND) , lEDIM, LTDIM, ITMDIM, LATDIM, 
2  FKP, ALAM, ALOCT, SCTFRC, lEMAX) 


*****  PRINT  OUT  ALOCT 

WRITE  (6,*)  'MY  UT  =', (ITIME (ISECND) /3600) *100+ 

1  MOD (ITIME (ISECND), 3600) /60 

CALL  OUTP (ALOCT, LATDIM, LTDIM, 10,11,1, 3, LTDIM, 1, 0 . , 
1  'ALOCT' , 6, 132) 

C 

C  GET  THE  CURRENT  TIME 

C 

C 

C  *****  WRITE  AUGPAR 

C 


MSM10250 

MSM10260 

MSM10270 

MSM10280 

MSM10290 

MSM10300 

MSM10310 

MSM10320 

MSM10330 

MSM10340 

MSM10350 

MSM10360 

MSM10370 

MSM10380 

MSM10390 

MSM10400 

MSM10410 

MSM10420 

MSM10430 

MSM10440 

MSM10450 

MSM10460 

MSM10470 

MSM10480 

MSM10490 

MSM10500 

MSM10510 

MSM10520 

MSM10530 

MSM10540 

MSM10550 

MSM10560 

MSM10570 

MSM10580 

MSM10590 

MSM10600 

MSM10610 

MSM10620 

MSM10630 

MSM10640 

MSM10650 

MSM10660 

MSM10670 

MSM10680 

MSM10690 

MSM10700 

MSM10710 

MSM10720 

MSM10730 

MSM10740 

MSM10750 

MSM10760 

MSM10770 

MSM10780 

MSM10790 

MSM10800 

MSM10810 

MSM10820 

MSM10830 

MSM10840 

MSM10850 

MSM10860 

MSM10870 

MSM10880 


ooooooo  o  o  oooo 


msml.for 


WRITE  (6,*)  'AUGPAR  PARAMETERS' 
WRITE (6, 810) 


810  FORMAT (IX, ' 

lYEAR' ,2X, ' 

IDAY',2X,' 

I HOUR' , 2X, ' 

IMIN'  , 

2 

2X,' 

ISEC' ,2X, ' 

KP' ,2X, ' 

DST' ,2X, ' 

EQEDGE' , 

3 

2X, ' 

DLATAZ' ,2X, ' 

DLATRV',2X, ' 

MLTRV' ) 

WRITE  (6,  820)  (AUGPAR(LM,  IT) ,  11) 

820  F0RMAT(1X,11 (F8.2,2X) ) 

WRITE (6, 830) 

830  FORMAT (IX) 

WRITE (6, 840) 

840  FORMAT (IX,'  IMFBX',2X, '  IMFBy',2X,'  IMFBZ',2X,'  CLAPSE' , 

2  2X, '  GEOMGX',2X, '  GEOMGy',2X,'  GEOMGZ',2X,'  GEOMGT' , 

3  2X, '  LBOUND',2X,'  SWVEL',2X,'  SWDEN' ) 

WRITE (6, 820)  (AUGPAR (LM, IT) ,LM=12,22) 

WRITE (6, 830) 

WRITE (6, 850) 

850  FORMAT (IX, '  TILTW',2X, '  STAND', 2X,'  PCP',2X,'  IPATT' , 

2  2X, '  DDST',2X, '  DEQDT') 

WRITE (6, 820)  (AUGPAR(LM, IT) ,LM=23,28) 

WRITE (6, 830) 

C 

C 

C 

C 

C  GET  THE  CURRENT  TIME 
C 

C  CALL  DTIME(ISTBT) 

C 

C  CALCULATE  APPROXIMATE  PLASMAPAUSE  RADIUS  FOR  USE  IN  PPTM  FOR 
C  DETERMINING  WEAK  LOSS  RATE 

RPP (L) =1 . / (COS (AUGPAR (EQEDGE, L) ‘PI/ISO . ) ) **2 


CALCULATE  B  FIELD  MATRICES 

FSTOFF'AUGPAR (STAND, L) 

FEQEDG=AUGPAR (EQEDGE, L) 

FDST=AUGPAR (DST, L) 

FCLPSE=AUGPAR (CLAPSE, L) 

FTILT“AUGPAR(TILTW, L) 

WRITE  (6,*)  'L  -',L, '  FSTOFF  =',FSTOFF,'  FEQEDG  =',FEQEDG, 

1  '  FDST  =',FDST,'  FCLPSE  =',FCLPSE,'  FTILT  -' , 

2  FTILT,'  RPP  -',RPP(L) 

CALL  BTRACE (LATDIM, LTDIM, ITMDIM, L,  FSTOFF,  FEQEDG, FDST, 

2  FCLPSE, FTILT, VM, BMIN, XMIN, YMIN, ZMIN, R, P, ALOCT, TETA) 

GET  THE  CURRENT  TIME  AND  FIND  THE  TIME  SPENT  IN  BTRACE 

CALL  DTIME (lENDBT) 

WRITE  (LUERR,*)  'THE  TIME  SPENT  IN  BTRACE  IS  ', 

1  ABS(IENDBT-ISTBT)/100.,*  SECONDS.' 

WRITE(6,*)  'MY  UT  =' , (ITIME (ISECND) /3600) *100+ 

1  MOD (ITIME (ISECND) , 3600) /60, '  DAY=  ', ITIME (IDAY) 

WRITE (6,*)  'L-',L 
C 

ICNTRL  -  1 
C 

C  GET  THE  CURRENT  TIME 
C 

C  CALL  DTIME (I STEF) 

C 


MSM10890 

MSM10900 

MSM10910 

MSM10920 

MSM10930 

MSM10940 

MSM10950 

MSM10960 

MSM10970 

MSM10980 

MSM10990 

MSMllOOO 

MSMIIOIO 

MSM11020 

MSM11030 

MSM11040 

MSM11050 

MSM11060 

MSM11070 

MSM11080 

MSM11090 

MSMlllOO 

MSMllllO 

MSM11120 

MSM11130 

MSM11140 

MSM11150 

MSM11160 

MSM11170 

MSM11180 

MSM11190 

MSM11200 

MSM11210 

MSM11220 

MSM11230 

MSM11240 

MSM11250 

MSM11260 

MSM11270 

MSM11280 

MSM11290 

MSM11300 

MSM11310 

MSM11320 

MSM11330 

MSM11340 

MSM11350 

MSM11360 

MSM11370 

MSM11380 

MSM11390 

MSM11400 

MSM11410 

MSM11420 

MSM11430 

MSM11440 

MSM11450 

MSM11460 

MSM11470 

MSM11480 

MSM11490 

MSM11500 

MSM11510 

MSM11520 


ooo  oo  oooooooooo  ooooooooo  ooo 


msml.for 


WRITE (6,*)  'IN  EBCON' 

WRITE(6,*)  'EQEDGE=  ' , AUGPAR(EQEDGE, L) , '  STAND-  '  ,AUGPAR{ STAND, L) 
GET  BNDYS  FOR  USE  IN  EFIELD 
VDROP-AUGPAR(PCP,L) *1.E3 

CALL  EFBNDY (LATDIM, LTDIM, ITMDIM, L, AUGPAR(EQEDGE,  L)  , 

2  AUGPAR( STAND, L) , VDROP,R,ALOCT,COLAT, 

3  ASOUTH(l,L) ,BS0UTH(1,L) ,DXS(1,L)  ,DYS(1,L) ) 

CALL  EFBNDY (LATDIM, LTDIM, ITMDIM, L, AUGPAR (EQEDGE, L) , 


2 

3 


WRITE (6,*) 
WRITE{6,*) 
WRITE (6,*)  ' 
WRITE (6,*)  ' 


AUGPAR (STAiro, L) , VDROP , R, ALOCT, COLAT, 

AN0RTH(1,L) ,BNORTH(l,L) ,DXN (1, L) , DYN (1, L) ) 

'AFTER  EFBNDY  L=  ',L,'  A-  '  ,  (ANORTH (IIC, L) , IIC-1 , 3) 
'BNORTH-'  ,  (BNORTH(IIC,L)  ,IIC=1,3) 

DXN-  ', (DXN{IIC,L),IIC=1,3) 

DYN=  ', (DYN(IIC,L),IIC=1,3) 


IPATRN-AUGPAR (IPATT,  L) 

CALL  EFIELD ( IPATRN, VDROP, AUGPAR(DEQDT,L) , 

2  ASOUTH, BSOUTH, DXS, DYS, ANORTH, BNORTH,  DXN, DYN, COLAT, 

3  ALOCT, MODE, LATDIM, LTDIM, JWRAP, ITMDIM, L, ICNTRL, 1, V, 

4  VNORTH,VSOUTH) 

GET  THE  CURRENT  TIME  AND  FIND  THE  TIME  SPENT  IN  EFIELD 
CALL  DTIME(IENDEF) 

WRITE  (LUERR, *)  'THE  TIME  SPENT  IN  EFIELD  IS  ', 

1  ABS(IENDEF-ISTEF)/100.,'  SECONDS.' 

*****  WRITE  V 

CALL  OUTP (V ( 1 , 1 , L) , LATDIM, LTDIM, 1 , LATDIM, 1,1, LTDIM, 1,0., 
1  'V',6,132) 

WRITE(6,*)  'MY  UT  -' , (ITIME (ISECND) /3600) *100+ 

1  MOD (ITIME(ISECND) ,3600) /60,'  DAY-  ' , ITIME (IDAY) 
WRITE (6,*)  'L-',L 

CALL  OUTP (VNORTH, LATDIM, LTDIM, 1,  LATDIM,  1,1, LTDIM,  1,0., 

2  'VNORTH', 6, 132) 

CALL  OUTP (VSOUTH, LATDIM, LTDIM, 1 , LATDIM, 1,1, LTDIM, 1,0., 

2  'VSOUTH', 6, 132) 


FIND  BNDLOC  FOR  THIS  TIME 

CALL  FNDBND (L, COLAT, ALOCT, ANORTH (2, L)  ,  BNORTH (2,  L) , 

1  DXN(2,L) ,DYN(2,L) , LATDIM, LTDIM, ITMDIM, BNDLOC) 

COMPUTE  RBNDY 

WRITE (6,*)  'L-  ',L 
DO  8  J-1, LTDIM 
BI-BNDLOC(J,L) 

BJ-J 

BL-L 

RBNDY-G3NTRP (R, LATDIM, LTDIM, ITMDIM, BI , BJ,  BL) 

WRITE(6,*)  'J=',J,'  BNDLOC-' , BNDLOC (J,L) , '  RBNDY- ', RBNDY 
8  CONTINUE 


IBM-LATDIM 
DO  6  J J-1, LTDIM 


MSM11530 

MSM11540 

MSM11550 

M6M11560 

MSM11570 

MSM11580 

MSM11590 

MSM11600 

MSM11610 

MSM11620 

MSM11630 

MSM11640 

MSM11650 

MSM11660 

MSM11670 

MSM11680 

MSM11690 

MSM11700 

MSM11710 

MSM11720 

MSM11730 

MSM11740 

MSM11750 

MSM11760 

MSM11770 

MSM11780 

MSM11790 

MSM11800 

MSM11810 

MSM11820 

MSM11830 

MSM11840 

MSM11850 

MSM11860 

MSM11870 

MSM11880 

MSM11890 

MSM11900 

MSM11910 

MSM11920 

MSM11930 

MSM11940 

MSM11950 

MSM11960 

MSM11970 

MSM11980 

MSM11990 

MSM12000 

MSM12010 

MSM12020 

MSM12030 

MSM12040 

MSM12050 

MSM12060 

MSM12070 

MSM12080 

MSM12090 

MSM12100 

MSM12110 

MSM12120 

MSM12130 

MSM12140 

MSM12150 

MSM12160 


o  o  o  o 


msml.for 


IF{INT(BNDLOC(JJ, L) ) .LT.IBM)  THEN  MSM12170 

IBM=INT (BNDLOC { JJ, L) )  MSM12180 

END  IF  MSM12190 

CONTINUE  •  MSM12200 

MSM12210 

MSM12220 

*****  WRITE  VM,  BMIN,  XMIN,  YMIN,  ZMIN  MSM12230 

MSM12240 

WRITE{6,*)  'MY  UT  =',  (ITIMEdSECND)  73600)  *100+  MSM12250 

1  MOD (ITIME(ISECND) ,3600) 760  MSM12260 

WRITE (6,*)  'L=',L  MSM12270 

CALL  OUTP{VM(l,l,L),LATDIM,LTDIM, IBM,LATDIM, 1,3,LTDIM-1,1,  MSM12280 

1  l.,'VM',6,132)  MSM12290 

CALL  OUTP (BMIN, LATDIM, LTDIM, IBM, LATDIM, 2, 3, LTDIM-3, 3, 10 . ,  MSM12300 


*****  WRITE  VM,  BMIN,  XMIN,  YMIN,  ZMIN 


1  'BMIN' ,6,132) 

WRITE (6,*)  'MY  UT  =', (ITIME (ISECND) 73600) *100+ 

1  MOD (ITIME (ISECND) ,3600)760,'  DAY=  ', ITIME (IDAY) 

WRITE(6,*)  'L=',L 

CALL  OUTP (XMIN, LATDIM, LTDIM, IBM, LATDIM, 2, 3, LTDIM-3, 3,1., 
1  'XMIN', 6, 132) 

WRITE(6,*)  'MY  UT  •=',  (ITIME  (ISECND)  73600)  *100+ 

1  MOD (ITIME (ISECND), 3600) 760,'  DAY=  ', ITIME (IDAY) 

WRITE (6,*)  'L=',L 

CALL  OUTP (YMIN, LATDIM, LTDIM, IBM, LATDIM, 2, 3, LTDIM-3, 3,1., 
1  'YMIN' , 6, 132) 

WRITE(6,*)  'MY  UT  =', (ITIME (ISECND) 73600) *100+ 

1  MOD (ITIME (ISECND), 3600) 760,'  DAY=  ', ITIME (IDAY) 

WRITE (6,*)  'L“',L 

CALL  OUTP (ZMIN, LATDIM, LTDIM, IBM, LATDIM, 2, 3, LTDIM-3, 3,1., 
1  'ZMIN', 6, 132) 

WRITE(6,*)  'MY  UT  -', (ITIME (ISECND) 73600) *100+ 

1  MOD (ITIME (ISECND), 3600) 760,'  DAY-  ', ITIME (IDAY) 

WRITE (6,*)  'L-',L 

CALL  OUTP (R (1 , 1 , L) , LATDIM, LTDIM, IBM, 45,1,1, LTDIM, 1,1., 

1  'R',6,132) 


MSM12310 

MSM12320 

MSM12330 

MSM12340 

MSM12350 

MSM12360 

MSM12370 

MSM12380 

MSM12390 

MSM12400 

MSM12410 

MSM12420 

MSM12430 

MSM12440 

MSM12450 

MSM12460 

MSM12470 

MSM12480 

MSM12490 

MSM12500 

MSM12510 

MSM12520 

MSM12530 

MSM12540 

MSM12550 


C  WRITE(6,*)  'MY  UT  -', (ITIME (ISECND) 73600) *100+  MSM12530 

C  1  MOD (ITIME (ISECND) ,3600)760,'  DAY-  ', ITIME (IDAY)  MSM12540 

C  WRITE (6,*)  'L-',L  MSM12550 

C  CALL  OUTP (P ( 1 , 1 , L) , LATDIM, LTDIM, IBM, LATDIM, 1,1, LTDIM, 1,0.01, MSM12560 

C  1  'P',6,132)  MSM12570 

C  SET  VMLOSS  FOR  THE  CURRENT  VM  PARAMETERS  MSM12580 

C  MSM12590 

CALL  VMLSET(L,VM,BIR, SINI, LATDIM, LTDIM, ITMDIM, VMLOSS)  MSM12600 

C  MSM12610 

C  *****  WRITE  VMLOSS  MSM12620 

C  MSM12630 

C  CALL  OUTP (VMLOSS (1, 1, L) , LATDIM, LTDIM,  IBM, LATDIM, 2, 3, LTDIM-3, MSM12640 

C  1  3, 0.01, 'VMLOSS', 6, 132)  MSM12650 

C  MSM12660 

C  SET  UP  ID  ARRAYS  MSM12670 

C  MSM12680 

WRITE(6,*)  'BEFORE  ID  ARRAY  LOADED  L=' , L  MSM12690 

ID (1) -ITIME (lYEAR)  MSM12700 

ID (2) -ITIME (IDAY)  MSM12710 

ID (3) -ITIME (ISECND) 73600  MSM12720 

ID (4) -MOD (ITIME (ISECND) , 3600) 760  MSM12730 

ID (5) -MOD (ITIME (ISECND) ,60)  MSM12740 

ID(11)-L  MSM12750 

RID(1)-TIMTAG(L)  MSM12760 

RID(2)-AUGPAR(KP,L)  MSM12770 

RID(3)-AUGPAR(PCP,L)  MSM12780 

RID(4)=AUGPAR(DEQDT,L)  MSM12790 

C  MSM12800 


/  v" 


C 

C 


C 

c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 


1 

1 

1 

1 

1 

1 

1 

1 


msml.for 

->  WRITE  AUGPAR  TO  AN  ARCHIVAL  FILE  ****** 

ID(8)=NAUGEL 

ID(9)=1 

ID(10)=ITMMAX 

CALL  WRT3D(LUPDAT,IRECEB,ID,RID,CHID,AUGPAR(1,L) ,NAUGEL, 
1,1,ITMDIM) 

->  WRITE  VM,  BMIN,  XMIN,  YMIN,  ZMIN,  AND  V  TO  AN  ARCHIVAL  FILE 

ID(8)=LATDIM 

ID{9)-LTDIM 

ID(10)=1 

CALL  WRT3D(LUBFLD,IRECEB,ID,RID,CHID,VM(1,1,L) , 

LATDIM, LTDIM, 1 , ITMDIM) 

CALL  WRT3D (LUBMIN, IRECEB, ID, RID,  CHID,  BMIN, 

LATDIM, LTDIM, 1, ITMDIM) 

CALL  WRT3D (LUXMIN, IRECEB, ID, RID, CHID, XMIN, LATDIM, 

LTDIM, 1, ITMDIM) 

CALL  WRT3D (LUYMIN, IRECEB, ID, RID, CHID, YMIN, LATDIM, 

LTDIM, 1, ITMDIM) 

CALL  WRT3D (LUZMIN, IRECEB, ID, RID, CHID, ZMIN, LATDIM, 

LTDIM, 1, ITMDIM) 

CALL  WRT3D (LUEFLD, IRECEB, ID, RID, CHID,  V (1 , 1 ,  L)  ,  LATDIM, 

LTDIM, 1, ITMDIM) 

CALL  WRT3D (LUVN, IRECEB, ID, RID, CHID, VNORTH, LATDIM, 

LTDIM, 1, ITMDIM) 

CALL  WRT3D (LUVS, IRECEB, ID,RID,CHID, VSOUTH, LATDIM, 

LTDIM, 1, ITMDIM) 


- >  WRITE  ALOCT,  COLAT,  AND  BNDLOC  TO  ARCHIVAL  FILE 

ID (8) “LATDIM 
ID (9) “LTDIM 
ID(10)=1 

CALL  WRT3D (LUALOC, IRECEB, ID, RID, CHID, ALOCT, LATDIM, 
1  LTDIM, 1, ITMDIM) 

CALL  WRT3D (LUCOLT, IRECEB, ID, RID, CHID, COLAT, LATDIM, 
1  LTDIM, 1, ITMDIM) 

ID  (8) “LTDIM 

ID(9)“1 

ID(10)=1 

CALL  WRT3D(LUBNDL, IRECEB, ID, RID, CHID, BNDLOC (1,L)  , 

1  LTDIM, 1,1, ITMDIM) 


INCREMENT  ITIME 
12  CONTINUE 

CALL  TIMINC  (ITIME,  ITMNEW,  UNO 

ITIME (lYEAR) =ITMNEW (lYEAR) 
ITIME (IDAY) “ITMNEW (IDAY) 

ITIME (ISECND) -ITMNEW (I SECND) 


C 

C 

C 


MSM12810 

MSM12820 

MSM12830 

MSM12840 

MSM12850 

MSM12860 

MSM12870 

MSM12880 

MSM12890 

MSM12900 

MSM12910 

MSM12920 

MSM12930 

MSM12940 

MSM12950 

MSM12960 

MSM12970 

MSM12980 

MSM12990 

MSM13000 

MSM13010 

MSM13020 

MSM13030 

MSM13040 

MSM13050 

MSM13060 

MSM13070 

MSM13080 

MSM13090 

MSM13100 

MSM13110 

MSM13120 

MSM13130 

MSM13140 

MSM13150 

MSM13160 

MSM13170 

MSM13180 

MSM13190 

MSM13200 

MSM13210 

MSM13220 

MSM13230 

MSM13240 

MSM13250 

MSM13260 

MSM13270 

MSM13280 

MSM13290 

MSM13300 

MSM13310 

MSM13320 

MSM13330 

MSM13340 

MSM13350 

MSM13360 

MSM13370 

MSM13380 

MSM13390 

MSM13400 

MSM13410 

MSM13420 

MSM13430 

MSM13440 


msml.for 


10  CONTINUE 


C 

C 

C 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 


RETURN 


C 

C 

C 


C 

C 


C 

C 


END 


************************  BLOCK  DATA  ************************ 
BLOCK  DATA 

VERSION  1.0  DATE:  JANUARY  9,  1988 

PROGRAMMER:  BRYAN  A.  BALES 

PURPOSE:  THIS  BLOCK  DATA  CONTAINS  THE  INDEX  OF  DATA  ELEMENTS  IN  THE 

P ARRAY  AND  AUGPAR  ARRAYS. 


INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP, DST, DDST, 

1  EQEDGE,DLATAZ,DLATRV,MLTRV, IMFBX,  IMFBY,  IMFB2,  CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND, PCP.DEQDT, IP ATT 

COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP, DST, 

1  EQEDGE,  DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFB2, CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND, PCP,IPATT, DDST, DEQDT 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 

COMMON  /GRID/DLAM,DPSI,RI, JWRAP 

$ 

COMMON  /MOVE/IBEG, ISTOP, JBEG, JSTOP, lEBEG, lEEND 

DATA  lYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC,  KP,DST, 

1  EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND, PCP, IPATT, DDST, DEQDT 

4  71,2,3,3,4,5,6,7, 

5  8,9,10,11,12,13,14,15, 

6  16,17,18,19,20,21,22,23, 

7  24,25,26,27,28/ 

DATA  LUERR, LUPIEN, LUCORD, LUPRNT,  LUIDAT,  LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 

4  79,13,14,15,16,17, 

5  20,21,22,23,24,25,26,27, 

6  28,35,36,37,38,39,40,41, 

7  42,43,44,45,46,47,48,49/ 

DATA  IBEG,ISTOP, JBEG, JSTOP, I EBEG  71,53,3,50,1/ 

END 

SUBROUTINE  EMODEL (IPATT , PCP , DEQDT , A, B, DX , DY , COLAT , ALOCT , MODE , 

1  LATDIM,LTDIM, JWRAP,ICNTRL,ITOP,V) 

THIS  SUBROUTINE  RETURNS  VALUES  OF  THE  POTENTIAL  V  AT  ALL  GRID 


MSM13450 

MSM13460 

MSM13470 

MSM13480 

MSM13490 

MSM13500 

MSM13510 

MSM13520 

MSM13530 

MSM13540 

MSM13550 

MSM13560 

MSM13570 

MSM13580 

MSM13590 

MSM13600 

MSM13610 

MSM13620 

MSM13630 

MSM13640 

MSM13650 

MSM13660 

MSM13670 

MSM13680 

MSM13690 

MSM13700 

MSM13710 

MSM13720 

MSM13730 

MSM13740 

MSM13750 

MSM13760 

MSM13770 

MSM13780 

MSM13790 

MSM13800 

MSM13810 

MSM13820 

MSM13830 

MSM13840 

MSM13850 

MSM13860 

MSM13870 

MSM13880 

MSM13890 

MSM13900 

MSM13910 

MSM13920 

MSM13930 

MSM13940 

MSM13950 

MSM13960 

MSM13970 

MSM13980 

MSM13990 

MSM14000 

MSM14010 

MSM14020 

MSM14030 

MSM14040 

MSM14050 

MSM14060 

MSM14070 

MSM14080 


msml.for 

POINTS,  SPECIFIED  BY  COLAT(I,J)  AND  ALOCT(I,J) 


SECTION  2.4  OF  THE  FINAL  REPORT  FOR  CONTRACT  #F19628- 
87-K-OOOl. 


GENERAL  CALL  PARAMETERS  FOR  SUBROUTINE  EMODEL 


IPATT 


POINTS,  SPECIFIED  BY  COLAT(I,J)  AND  ALOCT(I,J),  MSM14090 

MSM14100 
MSM14110 

REFERENCE:  SECTION  2 . 4  OF  THE  FINAL  REPORT  FOR  CONTRACT  #F19628-  MSM14120 

87-K-OOOl.  MSM14130 

MSM14140 
MSM14150 
MSM14160 

2NERAL  CALL  PARAMETERS  FOR  SUBROUTINE  EMODEL  MSM14170 

MSM14180 

IPATT  -  HEPPNER-MAYNARD  PATTERN  NO.  MUST  BE  SPECIFIED  AS  AN  MSM14190 
INTEGER  BETWEEN  1  AND  7.  MSM14200 

IPATT=1  MEANS  PATTERN  A,  FOR  BZ  SOUTH,  BY»0.  MSM14210 

IPATT=2  MEANS  PATTERN  BC,  FOR  BZ  SOUTH,  BYNORTH>0  MSM14220 

IPATT=3  MEANS  PATTERN  DE,  FOR  BZ  SOUTH, BYNORTH<0  MSM14230 

IPAtt-4  MEANS  PATTERN  BCP, TWISTED  BC,  FOR  B2>0  MSM14240 

IPATT=5  MEANS  PATTERN  BCPP,  TWISTED  BC,BZ  STRONOO  MSM14250 

IPATT=6  MEANS  PATT.  DEP,  TWISTED  DE,BZ  WEAK  >0  MSM14260 

IPATT=7  MEANS  PATT.  DEPP,  TWISTED  DE,BZ  STRONOO  MSM14270 

MSM14280 

PCP  -  POLAR-CAP  POTENTIAL  DROP  IN  VOLTS.  MUST  BE  SPECIFIED  MSM14290 
UNLESS  USING  UNSCALED  HEPPNER-MAYNARD  POTENTIAL (ICNTRL=-1) MSM14300 

MSM14310 

DEQDT  -  ESTIMATED  D/DT  OF  LATITUDE  OF  EQUATORWARD  EDGE  OF  MSM14320 

AURORAL  ZONE  AT  LOCAL  MIDNIGHT,  IN  DEGREES/HOUR.  THIS  MSM14330 
IS  A  PARAMETER  IN  LOW-LATITUDE  E-FIELD  MODEL.  NOT  MSM14340 

NEEDED  IF  ICNTRL.LE.O.  MSM14350 

MSM14360 

VECTORS  A (3),  B(3),  DX(3),  DY(3)  DESCRIBE  THE  ELLIPSES  THAT  FORM  MSM14370 
THE  BOUNDARIES  BETWEEN  REGIONS  1,  2,  AND  3.  BOUNDARY  1  IS  THE  MSM14380 
EQUATORWARD  EDGE  OF  THE  POLAR  CAP.  BOUNDARY  2  IS  THE  EQUATORWARDMSM14390 


n 


HEPPNER-MAYNARD  PATTERN  NO.  MUST  BE  SPECIFIED  AS  AN 
INTEGER  BETWEEN  1  AND  7. 

IPATT=1  MEANS  PATTERN  A,  FOR  BZ  SOUTH,  BY»0. 

IPATT=2  MEANS  PATTERN  BC,  FOR  BZ  SOUTH,  BYNORTH>0 
IPATT=3  MEANS  PATTERN  DE,  FOR  BZ  SOUTH, BYNORTH<0 
IPATT-4  MEANS  PATTERN  BCP, TWISTED  BC,  FOR  B2>0 
IPATT-5  MEANS  PATTERN  BCPP,  TWISTED  BC,BZ  STRONOO 
IPATT-6  MEANS  PATT.  DEP,  TWISTED  DE,BZ  WEAK  >0 
IPATT-7  MEANS  PATT.  DEPP,  TWISTED  DE,BZ  STRONOO 


EDGE  OF  REGION  1  OR  THE  EQUATORWARD  EDGE  OF  THE  FIELD-REVERSAL 
REGION.  BOUNDARY  3  IS  THE  SHIELDING  LAYER. 

A(L)  -  RADIUS  OF  ELLIPSE  MEASURED  IN  X (SUNWARD)  DIRECTION. 

B(L)  -  RADIUS  OF  ELLIPSE  MEASURED  IN  Y(DUSKWARD)  DIRECTION. 
DX(L)  -  SUNWARD  DISPLACEMENT  OF  COORD. SYSTEM  CENTER  FROM  POLE. 
DY(L)  =  DUSKWARD  DISPL.  OF  COORD.  SYSTEM  CENTER  FROM  POLE. 

TO  USE  EFIELD  WITH  RCM,  CHOOSE  A(2)  -  B{2)  -  TETA{IMIN), 

DX(2)  -  -OFFSET*180./PI,  DY(2)  =  0.  ELLIPSE  PARAMETERS  FOR 
BOUNDARIES  1  AND  3  NEED  NOT  BE  SPECIFIED. 

COLAT  AND  ALOCT  ARE  THE  USUAL  MAGNETIC  COLATITUDE  AND  MAGNETIC 
LOCAL  TIME  ANGLES  IN  RADIANS. 

MODE  IS  A  DUMMY  PARAMETER,  NOT  CURRENTLY  USED. 

IMAX,  JMAX,  JWRAP  HAVE  THEIR  USUAL  MEANING,  SAME  AS  IN  RCM. 


ITMDIM 


ITMCUR 


ICNTRL 


NUMBER  OF  TIME  LABELS  IN  THE  V-MATRIX. 
RCM,  IT  SHOULD  BE  SET  EQUAL  TO  1. 


FOR  USE  WITH 


TIME-LABEL  NUMBER  OF  V-MATRIX  CURRENTLY  BEING  COMPUTED. 
FOR  USE  WITH  RCM,  IT  SHOULD  BE  SET  EQUAL  TO  1. 

1  MEANS  DIFFERENT  FORMULAS  ARE  USED  IN  REGIONS  1,2,3. 

0  MEANS  HEPPNER-MAYNARD  FORMULA  IS  USED  FOR  ALL 


MSM14400 

MSM14410 

MSM14420 

MSM14430 

MSM14440 

MSM14450 

MSM14460 

MSM14470 

MSM14480 

MSM14490 

MSM14500 

MSM14510 

MSM14520 

MSM14530 

MSM14540 

MSM14550 

MSM14560 

MSM14570 

MSM14580 

MSM14590 

MSM14600 

MSM14610 

MSM14620 

MSM14630 

MSM14640 


LATITUDES,  BUT  SCALED  TO  EXTERNALLY  SPECIFIED  PCP  AND  MSM14650 
ELLIPSE  PARAMETERS.  MSM14660 

-1  MEANS  HEPPNER-MAYNARD  FORMULA  IS  USED  FOR  ALL  MSM14670 

LATITUDES,  UNSCALED.  MSM14680 

-2  IS  THE  MODE  USED  FOR  USE  WITH  RCM.  HEPPNER-MAYNARD  MSM14690 
IS  USED  POLEWARD  OF  ELLIPSE  2,  AND  ON  ELLIPSE  2,  MSM14700 

SCALED  TO  FIT  SPECIFIED  POTENTIAL  DROP  AND  DIMENSIONSMSM14710 

OF  ELLIPSE  2.  MSM14720 


oo  ooo  no  oooooo 
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?  “  1  MEANS  THAT  A(l),  B(l),  DX(1),  DY(1)  ARE  COMPUTED 

INTERNALLY  IN  EFIELD.  OTHERWISE  THEY  MUST  BE  PASSED  TO 
EFIELD  FROM  OUTSIDE.  ITOP  IS  NORMALLY  =  1  FOR  USE  IN 

MSM.  ITOP  SHOULD  BE  SET  TO  1  FOR  USE  WITH  RCM. 
POTENTIAL  MATRIX  COMPUTED  IN  EMODEL.  IT  IS  DIMENSIONED  AT 
LATDIM  X  LTDIM 


SUBROUTINE  EMODEL  CALLS  SUBROUTINES  EPOT (HEPPNER-MAYNARD) , 
LOW (LOW-LATITUDES) ,  AURORA (REGION  2),  REG 1 (REGION  1). 


PARAMETER ( JDIM=51 ) 

DIMENSION  THETAA ( JDIM) , THETAB ( JDIM) , THETAC ( JDIM) 

DIMENSION  COLAT (LATDIM, LTDIM) , ALOCT (LATDIM, LTDIM) 

DIMENSION  V (LATDIM, LTDIM) 

DIMENSION  VA(JDIM) ,DVADT(JDIM) , VC (JDIM) ,DVCDT (JDIM) 

DIMENSION  VB (JDIM) ,VBLOW( JDIM) ,VBAZ ( JDIM) , DVBLO (JDIM) 

DIMENSION  DVBDT (JDIM) , DVBAZ (JDIM) 

DIMENSION  COEF(I8,18) ,MLBL(5) 

DIMENSION  A (3) ,  B(3),  DX(3),  DY(3) 

DIMENSION  XCO(18,18) ,AHM(2,7) , BHM (2, 7) , DXHM (2, 7 ) 

DIMENSION  DYHM(2,7) ,VMIN(7) ,VMAX(7) 

PARAMETER  VALUES 

NTAPE  -  FILE  NUMBER  FROM  WHICH  MAYNARD-RICH  COEFFICIENTS  ARE 
READ. 

IMAX  -  LATDIM 

JMAX  -  LTDIM 

IF ( JDIM. NE. LTDIM)  THEN 

WRITE (6, 184)  JDIM,  LTDIM 

184  FORMATdH  ,'JDIM  »  ',14,'  LTDIM  =  ',14, 'IN  EFIELD.') 

END  IF 

WRITE(6,*)  'IPATT,PCP,DEQDT' ,IPATT,PCP,DEQDT 

PI  -  3.141593 
PI2  -  2.*PI 
NTAPE  -  7 
NNMAX  -  16 
EPS  -  .01 
G  -  1. 
lEFF  -  IMAX 

CALL  INPUT (NTAPE, COEF, IPATT, XCO, AHM, BHM, DXHM, DYHM, VMIN, 

1  VMAX) 

FG  -  SCALING  FACTOR  THAT  CONVERTS  HM  POTENTIAL  TO  PRESENT  SITUATION 

IF(ICNTRL.GE.O)  THEN 

FG  -  PCP/ (VMAX (IPATT) -VMIN (IPATT) ) 

ELSE 

FG  -  1. 

END  IF 

WRITE (6, 903)  IPATT, VMAX (IPATT) , VMIN (IPATT) , FG 
903  FORMATdH  ,' IPATT,  VMAX,  VMIN,  FG  =  ',I5,3E15.5) 


COMPUTE  A(l) ,B(1) ,DX(1) ,DY(1)  IF  ITOP  -  1. 


MSM14730 

MSM14740 

MSM14750 

MSM14760 

MSM14770 

MSM14780 

MSM14790 

MSM14800 

MSM14810 

MSM14820 

MSM14830 

MSM14840 

MSM14850 

MSM14860 

MSM14870 

MSM14880 

MSM14890 

MSM14900 

MSM14910 

MSM14920 

MSM14930 

MSM14940 

MSM14950 

MSM14960 

MSM14970 

MSM14980 

MSM14990 

MSM15000 

MSM15010 

MSM15020 

MSM15030 

MSM15040 

MSM15050 

MSM15060 

MSM15070 

MSM15080 

MSM15090 

MSM15100 

MSM15110 

MSM15120 

MSM15130 

MSM15140 

MSM15150 

MSM15160 

MSM15170 

MSM15180 

MSM15190 

MSM15200 

MSM15210 

MSM15220 

MSM15230 

MSM15240 

MSM15250 

MSM15260 

MSM15270 

MSM15280 

MSM15290 

MSM15300 

MSM15310 

MSM15320 

MSM15330 

MSM15340 

MSM15350 

MSM15360 
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IF(ITOP.EQ.l) 


A(l) 
B(l) 
DX(1) 
DYd) 
END  IF 


A(2)  *AHM(1,IPATT)  /AHM{2,  IPATT) 

B(2) IPATT) /BHM (2, IPATT) 

DX(2)  +  A(2)* (DXHM(1,IPATT)-DXHM(2, IPATT) ) /AHM(2, 
DY(2)  +  B (2) *(DYHM(1, IPATT) -DYHM(2, IPATT) )/BHM(2, 


VMAXX  -  VMAX (IPATT) *FG 
VMINN  -  VMIN (IPATT) *FG 
SA-SIN( (A(3)-DX(3) )*PI/180.) 

VPENET  -  -13112. *G*DEQDT*SA 

VBAR  -  0.6*VMAXX  +  0.4*VMINN  -0.22*VPENET 


IF(ICNTRL.NE.-2)  THEN 

WRITE (6, 905)  IPATT, VMAXX, VMINN 

FORMAT (IH  IPATT, VMAXX, VMINN  -  ',15,2E15.5) 

WRITE(6,906)  A(l)  , A(2) , A(3) 

FORMATdH  ,'A(1),  A(2),  A(3)  -  ',3E15.5) 
WRITE(6,907)  B(l)  ,B(2)  ,B(3) 

FORMATdH  ,'B(1),  B(2),  B(3)  =  ',3E15.5) 
WRITE(6,908)  DX(l),  DX{2),  DX(3) 

FORMATdH  ,'DX(1),  DX(2),  DX(3)  =  ',3E15.5) 
WRITE(6,  909)  DYd),  DY(2),  DY(3) 

FORMATdH  ,'DY(1),  DY(2),  DY(3)  =  ',3E15.5) 
WRITE (6, 899)  VPENET, VBAR, VMAXX, VMINN 
FORMAT (IH  , 'VPENET, VBAR, VMAX, VMIN=' , 4E15.5) 

END  IF 


IF(ICNTRL.EQ.O.OR.ICNTRL.EQ.-l)  GO  TO  15 
COMPUTATION  OF  BOUNDARY  LOCATIONS  AS  FCNS  OF  J. 


GUARD  AGAINST  IRRELEVANT 


OR  B'S  BEING  ZERO  OR  NEGATIVE. 


DO  811  L-1,3 

IF(A(L) .LT. 0.001)  A(L)=0.001 
IF(B(L) .LT. 0.001)  B(L)  =  0.001 
CONTINUE 


DO  1  J  -  1,  UMAX 

AL  -  ALOCTdEFF,  J) 

THETAA(J)  -  THET(A(1) ,B(1) ,DX(1) ,DY(1) ,AL) *PI/180. 
THETAB(J)  -  THET (A(2) ,B(2) ,DX(2) ,DY(2) ,AL) ‘PI/180. 
THETAC(J)  «  THET(A(3) ,B(3) ,DX(3) ,DY(3) ,AL) ‘PI/180. 
CONTINUE 

SEGMENT  FOR  DEFINING  BOUNDARY  POTENTIALS  AND  E-FIELDS 


POTENTIAL  AND  DERIVATIVE  AT  BOUNDARY  A 
GLONG  *  ALOCTdEFF,  J)  +  PI 

IF  (GLONG.GT.  (2.‘PI) )  GLONG  =  GLONG  -  2. ‘PI 
GMLAT  -  90.  -  THETAA(J) ‘180. /PI 

CALL  EPOT (COEF, GMLAT, GLONG, VA ( J) , NTAPE,  IPATT,  NNMAX, A, B, 
L  DX,DY,XCO,AHM, BHM, DXHM,DYHM,VMIN, VMAX, PCP, ICNTRL) 

GMLAT  -  GMLAT  -  EPS*180./PI 

CUVLL  EPOT ( COEF , GMLAT , GLONG ,VT, NTAPE, IPATT, NNMAX , A , B , 

I  DX, DY, XCO, AHM, BHM, DXHM, DYHM, VMIN, VMAX, PCP, ICNTRL) 


MSM15370 
MSM15380 
MSM15390 
MSM15400 
IPATT) MSM15410 
IPATT) MSM15420 
MSM15430 
MSM15440 
MSM15450 
MSM15460 
MSM15470 
MSM15480 
MSM15490 
MSM15500 
MSM15510 
MSM15520 
MSM15530 
MSM15540 
MSM15550 
MSM15560 
MSM15570 
MSM15580 
MSM15590 
MSM15600 
MSM15610 
MSM15620 
MSM15630 
MSM15640 
MSM15650 
MSM15660 
MSM15670 
MSM15680 
MSM15690 
MSM15700 
MSM15710 
MSM15720 
MSM15730 
MSM15740 
MSM15750 
MSM15760 
MSM15770 
MSM15780 
MSM15790 
MSM15800 
MSM15810 
MSM15820 
MSM15830 
MSM15840 
MSM15850 
MSM15860 
MSM15870 
MSM15880 
MSM15890 
MSM15900 
MSM15910 
MSM15920 
MSM15930 
MSM15940 
MSM15950 
MSM15960 
MSM15970 
MSM15980 
MSM15990 
MSM16000 


ci  n  a  ooooooo  ooo  oooo  oooo  n  ci  n 
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DVADT(J)  =  (VT-VA(J) ) /EPS  MSM16010 

CONTINUE  MSM16020 

MSM16030 

POTENTIAL  AND  DERIVATIVE  AT  C  MSM16040 

MSM16050 

DO  8  J-1,  JMAX  MSM16060 

CALL  LOW(THETAC(J) , ALOCT (lEFF, J) ,VC(J) ,DEQDT, A(3) ,DX (3) , VBAR, G) MSM16070 


(VT-VA(J) ) /EPS 


POTENTIAL  AND  DERIVATIVE  AT 


TT  -  THETAC(J)  +  EPS 

CALL  LOW(TT,  ALOCT (lEFF, J) , VT, DEQDT, A (3) , DX (3) , VBAR, G) 
DVCDT ( J)  -  (VT-VC ( J) ) /EPS 
CONTINUE 


POTENTIAL  AT  B 

DO  9  J-1, JMAX 

GLONG  -  ALOCT (IEFF,J)+PI 

IF(GLONG.GT. (2.*PI) )  GLONG  -  GLONG-2.*PI 

GMLAT  -  90.  -  THETAB(J) *180./PI 

CALL  EPOT (COEF, GMLAT, GLONG, VB { J) , NTAPE, IPATT, NNMAX, A, B, 
L  DX, DY, XCO, ARM, BHM, DXHM, DYHM, VMIN, VMAX, PCP, ICNTRL) 

VBLOW(J)  -  VC(J)  -  DVCDT (J) * (THETAC(J)-THETAB(J) ) 
VBAZ(J)  =  VB(J)  -  VBLOW(J) 

CONTINUE 


DERIVATIVE  AT  POTENTIAL  AT  B 

DO  10  J  -  1,  JMAX 

DVBLO(J)  -  DVCDT (J) 

TT  -  THETAB(J)  +  EPS 

CALL  AURORA (TT, ALOCT (IEFF,J) , VT, VBAZ, THETAB ( J) , THETAC ( J) , J, 
1  JMAX,JWRAP) 

DVBAZ(J)  -  (VT-VBAZ(J) ) /EPS 
DVBDT(J)  =  DVBLO{J)  +  DVBAZ ( J) 

CONTINUE 

NMAX-NNMAX 

MAIN  DO  LOOP  OVER  GRID 
CONTINUE 

DO  5  I  -  1,  IMAX 
DO  5  J  -  1,  JMAX 
V(I,J)-  0. 


CALLS  OF  DIFFERENT  SUBROUTINE  SEQUENCES 


REGION  ZERO 


POLAR  CAP 


IF(COLAT(I, J) .LE.THETAA(J) . OR. ICNTRL. EQ. 0 , OR. ICNTRL. EQ. -1 ) 
GLONG  -  ALOCT (I, J)  +  PI 
IF  ( GLONG. GT.PI2)  GLONG-GLONG-PI2 
GMLAT  -  90.  -  COLAT{I,J)*180./PI 

CALL  EPOT ( COEF , GMLAT , GLONG , VTEMP , NTAPE , I P ATT , NNMAX , A , 

B, DX, DY, XCO, AHM, BHM, DXHM, DYHM, VMIN, VMAX , PCP , ICNTRL) 
END  IF 


REGION 


LOW  LATITUDES 


IF(COLAT(I, J) .GE. THETAC (J) .AND. ICNTRL. GT. 0)  THEN 

CALL  LOW(COLAT(I, J) , ALOCT (I, J) , VTEMP, DEQDT, A (3) ,DX(3) ,VBAR,G) 


MSM16080 
MSM16090 
MSM1610C 
MSM16110 
MSM16120 
MSM16130 
MSM16140 
MSM16150 
MSM16160 
MSM16170 
MSM16180 
MSM16190 
MSM16200 
MSM16210 
MSM16220 
MSM16230 
MSM16240 
MSM16250 
MSM16260 
MSM16270 
MSM16280 
MSM16290 
MSM16300 
MSM16310 
MSM16320 
MSM16330 
MSM16340 
MSM16350 
MSM16360 
MSM16370 
MSM16380 
MSM16390 
MSM16400 
MSM16410 
MSM16420 
MSM16430 
MSM16440 
MSM16450 
MSM16460 
MSM16470 
MSM16480 
MSM16490 
MSM16500 
MSM16510 
THENMSM16520 
MSM16530 
MSM16540 
MSM16550 
MSM16560 
MSM16570 
MSM16580 
MSM16590 
MSM16600 
MSM16610 
MSM16620 
G)  MSM16630 
MSM16640 
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END  IF 


REGION  2  -  LOWER  AURORAL  ZONE 

IF(COLAT(I,  J)  .LT.THETAC(J)  .AND.COLATd,  J)  .GE.  THETAB  ( J)  .AND.ICNTRL. 
1  GT.O)  THEN 

VLOW  -  VC(J)  +  DVCDT(J)  *  (COLAT (I, J) -THETAC ( J) ) 

CALL  AURORA (COLAT ( I, J) ,ALOCT(I, J) , VAZ, VBAZ, THETAB (J) , THETAC (J) , 
%  J,  JMAX,JWRAP) 

VTEMP  -  VAZ  +  VLOW 
END  IF 

IF(COLAT(I, J) .LT.THETAB(J) . AND . COLAT (I, J) . GT. THETAA ( J) .AND.ICNTRL. 
1  GT.O)  THEN 

CALL  REGl  (COLATd,  J)  ,ALOCT(I,  J)  ,  VTEMP,  THETAA  (J)  , 

%  THETAB (J) ,VA(J) ,VB(J) , DVADT ( J) , DVBDT { J) ) 

END  IF 

USE  HEPPNER-MAYNARD  DIRECTLY  IN  REGION  1  FOR  USE  WITH  RCM. 

TB  -  THETAB (J)  +  l.E-4 

IF (COLAT (I, J) . LT.TB. AND. COLAT (I,J) . GT. THETAA (J) . AND . ICNTRL. EQ. -2 ) 

1  THEN 

GLONG  -  ALOCT(I,J)  +  PI 
IF(GL0NG.GT.PI2)  GLONG  =  GLONG  -  PI2 

CALL  EPOT (COEF, GMLAT, GLONG, VTEMP, NTAPE, IP ATT, NNMAX, A, 

1  B, DX, DY, XCO, AHM, BHM, DXHM, DYHM, VMIN, VMAX, PCP, ICNTRL) 

END  IF 

V(I,J)-  VTEMP 

5  CONTINUE 
RETURN 
END 


SUBROUTINE  EPOT (COEF, TLAT, TLON, VALUE, NTAPE, IPATT, NNMAX, A, B, 

1  DX,  DY,  XCO,  AHM,  BHM, DXHM, DYHM, VMIN, VMAX, PCP, ICNTRL) 

PURPOSE:  THIS  SUBROUTINE  USES  THE  SCALED  HEPPNER-MAYNARD  MODEL  TO 

RETURN  THE  ELECTRIC  POTENTIAL  AT  A  SPECIFIC  POINT. 

REFERENCE:  SECTION  2 . 4  OF  THE  FINAL  REPORT  FOR  CONTRACT  #F19628- 

87-K-OOOl. 


INPUTS: 

COEF 


TLON 

NTAPE 

IPATT 

NNMAX 

A 

B 

DX 


COEFFICIENTS  FROM  DIGITIZATION  OF  HEPPNER-MAYNARD 
E-FIELD  MODEL 

CO LATITUDE  OF  PT  WHERE  V  IS  TO  BE  CALCULATED 
(RADIANS) 

MLT  OF  PT  WHERE  V  IS  TO  BE  CALCULATED 

UNIT  NUMBER  OF  FILE  FROM  WHICH  COEFFICIENTS  ARE  READ 

HEPPNER-MAYNARD  PATTERN  TYPE 

NUMBER  OF  COEFFICIENTS 

RADIUS  OF  ELLIPSE  IN  X  (SUNWARD)  DIRECTION 
RADIUS  OF  ELLIPSE  IN  Y  (DUSKWARD)  DIRECTION 
OFFSET  OF  ELLIPSE  IN  X  DIRECTION 

rNC*  c»t  t  TT^otr  v  T>Tr>t»r'»nTrMkT 


MSM16650 

MSM16660 

MSM16670 

MSM16680 

MSM16690 

MSM16700 

MSM16710 

MSM16720 

MSM16730 

MSM16740 

MSM16750 

MSM16760 

MSM16770 

MSM16780 

MSM16790 

MSM16800 

MSM16810 

MSM16820 

MSM16830 

MSM16840 

MSM16850 

MSM16860 

MSM16870 

MSM16880 

MSM16890 

MSM16900 

MSM16910 

MSM16920 

MSM16930 

MSM16940 

MSM16950 

MSM16960 

HSM16970 

MSM16980 

MSM16990 

MSM17000 

MSM17010 

MSM17020 

MSM17030 

MSM17040 

MSM17050 

MSM17060 

MSM17070 

MSM17080 

MSM17090 

MSM17100 

MSM17110 

MSM17120 

MSM17130 

MSM17140 

MSM17150 

MSM17160 

MSM17170 

MSM17180 

MSM17190 

MSM17200 

MSM17210 

MSM17220 

MSM17230 

MSM17240 

MSM17250 

MSM17260 

MSM17270 


c  xco 

C  AHM 
C  BHM 
C  DXHM 
C  DYHM 
C  VMIN 
C  VMAX 
C  PCP 
C  ICNTRL 
C 
C 
C 
C 
C 
C 

C  OUTPUT : 

C  VALUE 


msml.for 


COEFFICIENTS 

HEPPNER-MAYNARD  X  RADIUS 
HEPPNER-MAYNARD  Y  RADIUS 
HEPPNER-MAYNARD  X  OFFSET 
HEPPNER-MAYNARD  Y  OFFSET 

ELECTRIC  POTENTIAL  MIN  FROM  HEPPNER-MAYNARD  MODEL 
ELECTRIC  POTENTIAL  MAX  FROM  HEPPNER-MAYNARD  MODEL 
MEASURED  CROSS -POLAR-CAP  POTENTIAL  DROP 
=  1  MEANS  DIFFERENT  FORMULAS  USED  IN  REGIONS  1,2,3 
=  2  H-M  USED  AT  ALL  LATITUDES,  BUT  SCALED  TO  PCP  AND 
ELLIPSE  PARAMETERS 

=-l  H-M  USED  AT  ALL  LATITUDES,  UNSCALED 
=-2  SHOULD  NOT  BE  USED.  RESERVED  FOR  USE  WITH  RICE 
CONVECTION  MODEL 


ELECTRIC  POTENTIAL  (VOLTS) 


C 

DIMENSION  AHM(2,7) ,BHM(2,7) ,DXHM(2,7) ,DyHM(2,7) 

DIMENSION  VMIN (7) , VMAX (7) 

DIMENSION  A (3) ,  B(3),  DX{3),Dy(3) 

DIMENSION  COEF(18,18) ,P(18,18) 

C 

DIMENSION  DP (18, 18) , CONST (18, 18)  ,SP(18), 

X  CP (18) ,FN(18) ,FM(18) 

DIMENSION  XCO(18, 18) ,MLBL(5) 

C 

DATA  CMIN,CMAX/50.,90./ 

DATA  P,CONST/648*0./ 

80  CONTINUE 
C 
C 

NMAX  =  NNMAX 
C 

PI  =  3.1415927 

VALUE=-1 .E-9 

IF (TLAT . GT . CMIN) GOTO70 

PRINT  *, 'LATITUDE  ',TiJ^T,'  OUT  OF  MODEL  RANGE' 

RETURN 

C 

70  CONTINUE 
C 

C  SEGMENT  FOR  SCALING  GRID-PT.  LOCATION  TO  FIT  H-M  ELLIPSE. 

TOOL  =  90. -TLAT 
TLONG  =  TLON  -  PI 
IF (ICNTRL. GE. 0)  THEN 

XX  =  DXHMd,  IPATT)+AHM(1,  IPATT)  *  (TCOL*COS  (TLONG) -DX(1)  ) /A(l) 
YY  -  DYHMd,  IPATT)+BHM(1,  IPATT)  *  (TCOL*SIN(TLONG) -DY(1)  ) /B(l) 
ELSE 

XX  -  TCOL*COS (TLONG) 

YY  =  TCOL* SIN (TLONG) 

END  IF 

XCOL  =  SORT (XX* *2  +  YY**2) 

XLAT  =  90. -XCOL 
XL  -  ATAN2(YY,XX) 

XLON  =  XL+PI 
ALPHA-=2  .  /  (CMAX-CMIN) 

BETA=1 . -ALPHA*CMAX 
CT-XLAT*ALPHA+BETA 
ST-SQRT(1.-CT*CT) 

SPH=SIN(XLON) 

CPH-COS (XLON) 

C 


2 

MSM17290 

MSM17300 

MSM17310 

MSM17320 

MSM17330 

MSM17340 

MSM17350 

MSM17360 

MSM17370 

MSM17380 

MSM17390 

MSM17400 

MSM17410 

MSM17420 

MSM17430 

MSM17440 

MSM17450 

MSM17460 

MSM17470 

MSM17480 

MSM17490 

MSM17500 

MSM17510 

MSM17520 

MSM17530 

MSM17540 

MSM17550 

MSM17560 

MSM17570 

MSM17580 

MSM17590 

MSM17600 

MSM17610 

MSM17620 

MSM17630 

MSM17640 

MSM17650 

MSM17660 

MSM17670 

MSM17680 

MSM17690 

MSM17700 

MSM17710 

MSM17720 

MSM17730 

MSM17740 

MSM17750 

MSM17760 

MSM17770 

MSM17780 

MSM17790 

MSM17800 

MSM17810 

MSM17820 

MSM17830 

MSM17840 

MSM17850 

MSM17860 

MSM17870 

MSM17880 

MSM17890 

MSM17900 

MSM17910 

MSM17920 


msml.for 


IF  (P(l,l) .NE.O.)  GOTO  3 

MSM17930 

P(l,l)=1.0 

MSM17940 

DP(1,1)=0.0 

MSM17950 

SP{1)=0.0 

MSM17960 

CP  (1) =1.0 

MSM17970 

DO  2  N=2,18 

MSM17980 

FN  (N)  =N 

MSM17990 

DO  2  M=1,N 

MSM18000 

FM (M) =M-1 

MSM18010 

2  CONST (N,M) “FLOAT ( (N-2) **2- (M-1) **2) / 

MSM18020 

X  FLOAT ( (2*N-3)* (2*N-5) ) 

MSM18030 

MSM18040 

3  SP(2)=SPH 

MSM18050 

P(l,l)=l. 

MSM18060 

CP(2)=CPH 

MSM18070 

DO  4  M=3,NMAX 

MSM18080 

SP {M)=SP (2) *CP (M-1) +CP (2) *SP (M-1) 

MSM18090 

4  CP (M)=CP (2) *CP (M-1) -SP (2) *SP (M-1) 

MSM18100 

MSM18110 

VALUE=COEF(l,l) 

MSM18120 

MSM18130 

DO  8  N=2,NMAX 

MSM18140 

DO  8  M=1,N 

MSM18150 

MSM18160 

IF  (N.NE.M)  GOTO  6 

MSM18170 

P (N,N)=ST*P (N-1,N-1) 

MSM18180 

DP(N,N)=ST*DP (N-1,N-1)+CT*P (N-1,N-1) 

MSM18190 

GOTO  8 

MSM18200 

6  IF  (N.NE.2)  P(N,M)=CT*P(N-1,M) -CONST (N,M)*P(N-2,M) 

MSM18210 

IF  (N.EQ.2)  P(N,M)-CT*P(N-1,M) 

MSM18220 

DP (N,M) =CT*DP (N-1,M) -ST*P (N-1,M) - 

MSM18230 

X  CONST (N,M) *DP (N-2,M) 

MSM18240 

MSM18250 

MSM18260 

8  CONTINUE 

MSM18270 

MSM18280 

P(l,l)=P(l,l)*XCO(l,l) 

MSM18290 

MSM18300 

VALUE-COEF (1,1)*P(1,1) 

MSM18310 

DO  10  N=2,NMAX 

MSM18320 

DO  10  M=1,N 

MSM18330 

IF  (M.EQ.l)  GOTO  11 

MSM18340 

POL=P (N, M) *XCO (N, M) 

MSM18350 

P(M-l,N)“CP(M)*POL 

MSM18360 

P(N,M)=SP(M)*POL 

MSM18370 

VALUE=VALUE+P (M-1 , N) *COEF (M-1 , N) + 

MSM18380 

X  P(N,M) *COEF(N,M) 

MSM18390 

GOTO  10 

MSM18400 

11  P(N,M)=P(N,M)*XCO(N,M) 

MSM18410 

VALUE=VALUE+P (N,M) *COEF (N,M) 

MSM18420 

10  CONTINUE 

MSM18430 

IF (ICNTRL.NE.-l)  THEN 

MSM18440 

VALUE  =  (PCP/ (VMAX(IPATT) -VMIN(IPATT) ) ) *VALUE*1000. 

MSM18450 

ELSE 

MSM18460 

VALUE  =  1000. ‘VALUE 

MSM18470 

END  IF 

MSM18480 

MSM18490 

MSM18500 

RETURN 

MSM18510 

END 

MSM18520 

MSM18530 

MSM18540 

SUBROUTINE  LOW (COL,  ALO, VLOW, DEQDT, AEQEDG, DXEQEG, VBAR, G) 

MSM18550 

MSM18560 

ooo  ooooooonooooooooooooooo  non 


msml.for 

C  PURPOSE:  RETURN  THE  ELECTRIC  POTENTIAL  AT  A  SPECIFIC  LOCATION  IN 
C  THE  LOW-LATITUDE  REGION  OF  THE  ELECTRIC  FIELD  MODEL. 

C 

C  REFERENCE : 

C 
C 

C  INPUTS : 

C  COL 
C  ALO 
C  DEQDT 

C 

C  AEQEDG 
C  DXEQEG 
C  VBAR 
C  G 
C 
C 

C  OUTPUT: 

C  VLOW 
C 
C 
C 

PI  =  3.1415927 
AK  »  1.38 

SA  =  SIN( (AEQEDG-DXEQEG) *PI/180. ) 

CF  =  2. 75*1000. *1.576*G*DEQDT*SA/SIN(. 4363) 

FAC  “  .6103*SIN(ALO)-.0154*SIN(2.*ALO)-.021*SIN(3.*ALO) 

FAC  =  FAC  -  .1092*COS(ALO)+.1676*COS(2.*ALO)-.0314*COS(3.*ALO) 

VLOW  -  CF*FAC* (SA/SIN(COL) ) **AK  +  VBAR 

RETURN 

END 


SECTION  2.4  OF  THE  FINAL  REPORT  FOR  CONTRACT  #F19628- 
87-K-OOOl. 


COLATITUDE  (RADIANS) 

MLT  (RADIANS) 

TIME  RATE  OF  CHANGE  OF  EQUATORWARD  EDGE  OF  AURORAL 
ZONE  (DEGREES /HOUR) 

RADIUS  OF  ELLIPSE  3  IN  X  (SUNWARD)  DIRECTION 
OFFSET  OF  ELLIPSE  3  IN  X  DIRECTION 
AVERAGE  POTENTIAL  AT  LOW  LATITUDES 
WEIGHTING  FACTOR 


ELECTRIC  POTENTIAL  (VOLTS) 


SUBROUTINE  AURORA (COL, ALO, VAZ, VBAZ, TB, TC, J, JMAX, JWRAP) 

PURPOSE:  PROVIDE  THE  ELECTRIC  POTENTIAL  AT  A  SPECIFIC  LOCATION  IN 

THE  AURORAL  REGION  OF  THE  ELECTRIC  FIELD  MODEL. 


REFERENCE : 


SECTION  2.4  OF  THE  FINAL  REPORT  FOR  CONTRACT  #F19628- 
87-K-OOOl . 


INPUTS : 
COL 
ALO 
VBAZ 
TB 
TC 
J 

JMAX 

JWRAP 


COLATITUDE  OF  POINT 
MLT  OF  POINT 

AURORAL  CONTRIBUTION  TO  POTENTIAL 
LOCATION  OF  BOUNDARY  B  FOR  SPECIFIC  LOCAL  TIME 
LOCATION  OF  BOUNDARY  C  FOR  SPECIFIC  LOCAL  TIME 
LOCAL  TIME  INDEX 

MAXIMUM  NUMBER  OF  PTS  IN  J  (LONGITUDE)  DIRECTION 
NUMBER  OF  PTS  OF  OVERLAP  IN  J  DIRECTION 


OUTPUT : 
VAZ 


ELECTRIC  POTENTIAL  (VOLTS) 


PARAMETER  (JDIM=51) 
DIMENSION  VBAZ(JDIM) 


IF(JDIM.NE. JMAX)  THEN 


MSM18570 

MSM18580 

MSM18590 

MSM18600 

MSM18610 

MSM18620 

MSM18630 

MSM18640 

MSM18650 

MSM18660 

MSM18670 

MSM18680 

MSM18690 

MSM18700 

MSM18710 

MSM18720 

MSM18730 

MSM18740 

MSM18750 

MSM18760 

MSM18770 

MSM18780 

MSM18790 

MSM18800 

MSM18810 

MSM18820 

MSM18830 

MSM18840 

MSM18850 

MSM18860 

MSM18870 

MSM18880 

MSM18890 

MSM18900 

MSM18910 

MSM18920 

MSM18930 

MSM18940 

MSM18950 

MSM18960 

MSM18970 

MSM18980 

MSM18990 

MSM19000 

MSM19010 

MSM19020 

MSM19030 

MSM19040 

MSM19050 

MSM19060 

MSM19070 

MSM19080 

MSM19090 

MSM19100 

MSM19110 

MSM19120 

MSM19130 

MSM19140 

MSM19150 

MSM19160 

MSM19170 

MSM19180 

MSM19190 

MSM19200 


msml.for 


WRITE (6, 147) JDIM, JMAX 
FORMAT (IH  ,'JDIM  =  ',14,' 
END  IF 
DPWIDE  -  1. 

DP AMP  -  2.0 
PI  -  3.1415927 
ALMIN  -  PI  -  .5*DPWIDE 
ALMAX  -  PI  +  .5*DPWIDE 


LTDIM  =  ',14, 'IN  AURORA.') 


IF ( ALO . GT . ALMIN . AND . ALO . LT . ALMAX )  THEN 
PHIP  ■=  COS  (  (PI*  (ALO-PI)  )  /DPWIDE) 
ELSE 

PHIP  =  0. 

END  IF 

IF  (J.EQ.l)  THEN 

JMl  =  JMAX  -  JWRAP 
ELSE 

JMl  =  J-1 
END  IF 

IF  (J.EQ.JMAX)  THEN 
JPl  =  JWRAP  +  1 
ELSE 

JPl  =  J+1 
END  IF 


DVBDPH  =  (VBAZ(JPl)  -  VBAZ ( JMl ) ) *PI/FLOAT ( JMAX-3) 

DENOM  '  TC  -  COL 
ANUM  =  TC  -  TB 

IF  (DENOM.lt. 0.001)  DENOM  =  0.001 

CORR  »  -DVBDPH*PHIP*DPAMP*6.75* (TC-COL) **2* (COL-TB) / (TC-TB) **3 
R  =  1. 

DTHETA  =  (1. 25-. 75*COS (ALO-.75*PI) )* (TC-TB) 

FAC2  =  (1.+ (TC-COL) **2/DTHETA**2)**(-R) 

FAC3  -  (1.+ (TC-TB) **2/DTHETA**2)**(-R) 

VAZ  -  VBAZ(J)* (1.-FAC2) / (1.-FAC3)  +  CORR 

RETURN 

END 


SUBROUTINE  REGl (COL, AL, VI , TA, TB, VAA, VBB, DVAA, DVBB) 

PURPOSE:  PROVIDE  ELECTRIC  POTENTIAL  IN  REGION  1  OF  THE  ELECTRIC 

FIELD  MODEL 


REFERENCE:  SECTION  2.4  OF  THE  FINAL  REPORT  FOR  CONTRACT  #F19628- 

87-K-OOOl. 


INPUTS : 
COL 
AL 
TA 
TB 
VAA 
VBB 
DVAA 
DVBB 


COLATITUDE  (RADIANS) 

MLT 

LOCATION  OF  BOUNDARY  A 
LOCATION  OF  BOUNDARY  B 

ELECTRIC  POTENTIAL  FOR  PT  ON  BOUNDARY  A 
ELECTRIC  POTENTIAL  FOR  PT  ON  BOUNDARY  B 
DERIVATIVE  OF  V  FOR  PT  ON  BOUNDARY  A 
DERIVATIVE  OF  V  FOR  PT  ON  BOUNDARY  B 


MSM19210 

MSM19220 

MSM19230 

MSM19240 

MSM19250 

MSM19260 

MSM19270 

MSM19280 

MSM19290 

MSM19300 

MSM19310 

MSM19320 

MSM19330 

MSM19340 

MSM19350 

MSM19360 

MSM19370 

MSM19380 

MSM19390 

MSM19400 

MSM19410 

MSM19420 

MSM19430 

MSM19440 

MSM19450 

MSM19460 

MSM19470 

MSM19480 

MSM19490 

MSM19500 

MSM19510 

MSM19520 

MSM1?';30 

MSM19540 

MSM19550 

MSM19560 

MSM19570 

MSM19580 

MSM19590 

MSM19600 

MSM19610 

MSM19620 

MSM19630 

MSM19640 

MSM19650 

MSM19660 

MSM19670 

MSM19680 

MSM19690 

MSM19700 

MSM19710 

MSM19720 

MSM19730 

MSM19740 

MSM19750 

MSM19760 

MSM19770 

MSM19780 

MSM19790 

MSM19e00 

MSM19810 

MSM19820 

MSM19830 

MSM19840 


onoo  oo  ooooooooooooooo  oo 


msml.for 


C  OUTPUT; 
C  VI 


C 


ELECTRIC  POTENTIAL  FOR  A  POINT  IN  REGION  1  (VOLTS) 


DT  “  TB  -  TA 

VI  -  VAA  +  DVAA* (COL-TA) 

VI  -  VI  +  (3.*(VBB-VAA)-(2.*DVAA+DVBB)*DT)*(C0L-TA)**2/DT**2 
VI  -  VI  +  (2.* (VAA-VBB)+(DVAA+DVBB)*DT)* (COL-TA) **3/DT**3 
RETURN 


END 


FUNCTION  THET(AA,BB,XC, YC,PHI) 

THIS  FUNCTION  GIVES  SOLUTION  TO  EQUATION  FOR  ELLIPSE  IN 
IN  FLAT  POLAR  COORDINATES.  IT  SPECIFIES  COLATITUDE  AS  A 
FUNCTION  OF  LOCAL  TIME. 

INPUTS : 

AA  RADIUS  OF  ELLIPSE  IN  X  (SUNWARD)  DIRECTION 

BB  RADIUS  OF  ELLIPSE  IN  Y  (DUSKWARD)  DIRECTION 

XC  X  DISPLACEMENT  OF  ELLIPSE 

YC  Y  DISPLACEMENT  OF  ELLIPSE 

PHI  MLT  HOUR  ANGLE 


OUTPUT; 

THET  COLATITUDE  OF  INPUT  ELLIPSE  AT  GIVEN  PHI 

CPHI  -  COS (PHI) 

SPHI  -  SIN(PHI) 

CA  -  (CPHI/AA)**2  +  (SPHI/BB)**2 
CB  -  -XC*CPHI/AA**2  -  YC*SPHI/BB**2 
CC  -  (XC/AA)**2  +  (YC/BB)**2  -  1. 

THET  »  (-CB+SQRT(CB**2-CA*CC) ) /CA 
RETURN 
END 


SUBROUTINE  INPUT (NTAPE,COEF, IPATT, XCO, AHM, BHM, DXHM, 

1  DYHM,VMIN,  VMAX) 

PURPOSE;  READ  IN  NECESSARY  INPUT  FOR  THE  COMPUTATION  OF  THE 
HEPPNER-MAYNARD  ELECTRIC  FIELD  MODEL 

DIMENSION  COEF(18,18) 

DIMENSION  DXHM(2,7) ,DYHM(2,7) 

DIMENSION  XCO(18,18),  AHM (2 , 7 ), BHM (2, 7) 

DIMENSION  VMIN(7) ,VMAX(7) ,YCO(18,18) 

DIMENSION  AAHM(2,7) ,BBHM(2,7) ,DDXHM(2,7) 

DIMENSION  DDYHM(2,7),  VVMAX(7),  VVMIN(7) 

CHARACTER* 50  MLBL 
DATA  (YCO(  1,  J)  ,  J=l,18)/ 

X  .282095E+00,  .488603E+00,  .109255E+01,  .228523E+01, 

X  .468333E+01,  .951188E+01,  .192265E+02,  .387523E+02, 

X  .779645E+02,  .156658E+03,  .314501E+03,  .630964E+03, 

X  .126523E+04,  .253611E+04,  .508196E+04,  .101809E+05, 

X  .203918E+05,  .408366E+05/ 

DATA  (YCO(  2, J) , J=l,18) / 

X  .488603E+00,  .488603E+00,  .546274E+00,  .144531E+01, 

X  .331161E+01,  .719031E+01,  .151999E+02,  .316411E+02, 

X  .652298E+02,  .133599E+03,  .272366E+03,  .553392E+03, 


MSM19850 

MSM19860 

MSM19870 

MSM19880 

MSM19890 

MSM19900 

MSM19910 

MSM19920 

MSM19930 

MSM19940 

MSM19950 

MSM19960 

MSM19970 

MSM19980 

MSM19990 

MSM20000 

MSM20010 

MSM20020 

MSM20030 

MSM20040 

MSM20050 

MSM20060 

MSM20070 

MSM20080 

MSM20090 

MSM20100 

MSM20110 

MSM20120 

MSM20130 

MSM20140 

MSM20150 

MSM20160 

MSM20170 

MSM20180 

MSM20190 

MSM20200 

MSM20210 

MSM20220 

MSM20230 

MSM20240 

MSM20250 

MSM20260 

MSM20270 

MSM20280 

MSM20290 

MSM20300 

MSM20310 

MSM20320 

MSM20330 

MSM20340 

MSM20350 

MSM20360 

MSM20370 

MSM20380 

MSM20390 

MSM20400 

MSM20410 

MSM20420 

MSM20430 

MSM20440 

MSM20450 

MSM20460 

MSM20470 

MSM20480 
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X  .112151E+04,  .226837E+04,  .458082E+04,  .923904E+04, 

X  .186151E+05,  .374743E+05/ 

DATA  (YCO{  3, J) , J=l, 18) / 

X  .946175E+00,  .109255E+01,  .546274E+00,  .590044E+00, 

X  .177013E+01,  .440314E+01,  .101333E+02,  .223736E+02, 

X  ,481754E+02,  .102038E+03,  .213661E+03,  .443701E+03, 

X  .915709E+03,  .188083E+04,  .384e46E+04,  .785168E+04, 

X  .159791E+05,  .324537E+05/ 

DATA  (yCO(  4, J), J=l,18)/ 

X  .186588E+01,  ,228523E+01,  .144531E+01,  .590044E+00, 

X  .625836E+00,  .207566E+01,  .555021E+01,  .134918E+02, 

X  ,310971E+02,  .693209E+02,  .151081E+03,  .324033E+03, 

X  .686782E+03,  .144253E+04,  .300864E+04,  .623988E+04, 

X  ■.128827E+05,  .264983E+05/ 

DATA  (YCO{  5, J) , J=l,  18) / 

X  .370249E+01,  .468333E+01,  .331161E+01,  .177013E+01, 

X  .625836E+00,  .656382E+00,  .236662E+01,  .674590E+01, 

X  .172496E+02,  .414272E+02,  .955522E+02,  .214328E+03, 

X  .471128E+03,  .102002E+04,  .218269E+04,  .462762E+04, 

X  .973844E+04,  .203694E+05/ 

DATA  (YCO(  6, J) , J=l,18) / 

X  .736787E+01,  .951188E+01,  .719031E+01,  .440314E+01, 

X  .207566E+01,  .656382E+00,  .683184E+00,  .264596E+01, 

X  .798499E+01,  .213929E+02,  .534153E+02,  .127330E+03, 

X  .293800E+03,  .661878E+03,  .146420E+04,  .319336E+04, 

X  .688612E+04,  .147131E+05/ 

DATA  (YCO(  7, J) , J=l, 18) / 

X  .146845E+02,  .192265E+02,  ,151999E+02,  .101333E+02, 

X  ,555021E+01,  .236662E+01,  .683184E+00,  .707163E+00, 

X  .291571E+01,  .926339E+01,  .259102E+02,  .671087E+02, 

X  .165101E+03,  .391572E+03,  .903721E+03,  .204248E+04, 

X  .454057E+04,  .996084E+04/ 

DATA  (YCO(  8, J) , J=l,18) / 

X  .292940E+02,  .387523E+02,  .316411E+02,  .223736E+02, 

X  .134918E+02,  .674590E+01,  .264596E+01,  .707163E+00, 

X  .728927E+00,  .317732E+01,  .105778E+02,  .307916E+02, 

X  ,825507E+02,  .209304E+03,  .509767E+03,  .120459E+04, 

X  .278052E+04,  .629979E+04/ 

DATA  (YCO(  9, J) , J=l, 18) / 

X  .584734E+02,  .779645E+02,  .652298E+02,  .481754E+02, 

X  .300971E+02,  .172496E+02,  .798499E+01,  .291571E+01, 

X  .728927E+00,  .748901E+00,  .343190E+01,  .119255E+02, 

X  .360281E+02,  .997819E+02,  .260366E+03,  .650553E+03, 

X  .157290E+04,  .370647E+04/ 

DATA  (YCOdO,  J) ,  J=l,  18)  / 

X  .116766E+03,  .156658E+03,  .133599E+03,  .102038E+03, 

X  ,693209E+02,  .414272E+02,  .213929E+02,  .926339E+01, 

X  .317732E+01,  .748901E+00,  .767395E+00,  .368030E+01, 

X  .133043E+02,  .416119E+02,  .118840E+03,  .318704E+03, 

X  .816138E+03,  .201755E+04/ 

DATA  (YCOdl,  J)  ,  J=l,18)  / 

X  ,233240E+03,  .314501E+03,  .272366E+03,  .213661E+03, 

X  .151081E+03,  .955522E+02,  .534153E+02,  .259102E+02, 

X  .105778E+02,  .343190E+01,  .767395E+00,  .784642E+00, 

X  .392321E+01,  .147120E+02,  .475361E+02,  .139761E+03, 

X  .384731E+03,  .100877E+04/ 

DATA  (YCOd2,  J)  ,  J=l,18)  / 

X  .465998E+03,  .630964E+03,  .553392E+03,  .443701E+03, 

X  .324033E+03,  .214328E+03,  .127330E+03,  .671087E+02, 

X  .307916E+02,  .119255E+02,  .368030E+01,  .784642E+00, 

X  .800822E+00,  .416119E+01,  .161472E+02,  .537941E+02, 

X  .162579E+03,  .458849E+03/ 

DATA  (YCOd3,  J)  ,  J=l,18)  / 

X  .931187E+03,  .126523E+04,  .112151E+04,  .915709E+03, 


MSM20490 

MSM20500 

MSM20510 

MSM20520 

MSM20530 

MSM20540 

MSM20550 

MSM20560 

MSM20570 

MSM20580 

MSM20590 

MSM20600 

MSM20610 

MSM20620 

MSM20630 

MSM20640 

MSM20650 

MSM20660 

MSM20670 

MSM20680 

MSM20690 

MSM20700 

MSM20710 

MSM20720 

MSM20730 

MSM20740 

MSM20750 

MSM20760 

MSM20770 

MSM20780 

MSM20790 

MSM20800 

MSM20810 

MSM20820 

MSM20830 

MSM20840 

MSM20850 

MSM20860 

MSM20870 

MSM20880 

MSM20890 

MSM20900 

MSM20910 

MSM20920 

MSM20930 

MSM20940 

MSM20950 

MSM20960 

MSM20970 

MSM20980 

MSM20990 

MSM21000 

MSM21010 

MSM21020 

MSM21030 

MSM21040 

MSM21050 

MSM21060 

MSM21070 

MSM21080 

MSM21090 

MSM21100 

MSM21110 

MSM21120 


o  o  o  o  o  o 


msml.for 


X  .686782E+03,  . 
X  .825507E+02,  . 
X  ,800822E+00,  . 
X  .603802E+02, 
DATA  (YCO{14,J) 
X  .186100E+04,  . 
X  .144253E+04,  . 
X  .209304E+03,  . 
X  ,416119E+01,  . 
X  .190939E+02, 
DATA  (YCO(15,J) 
X  .371962E+04,  . 
X  ,300864E+04,  . 
X  .509767E+03,  . 
X  .161472E+02,  . 
X  .484985E+01, 
DATA  (YCO(16,J) 
X  .743510E+04,  . 
X  .623988E+04,  . 
X  .120459E+04,  . 
X  .537941E+02,  . 
X  .857341E+00, 
DATA  (YCO(17,J) 
X  .148629E+05,  . 
X  .128827E+05,  . 
X  .278052E+04,  . 
X  .162579E+03,  . 
X  .857341E+00, 
DATA  (YCO(18,J) 
X  .297130E+05,  . 
X  .264983E+05,  . 
X  .629979E+04,  . 
X  .458849E+03,  . 
X  .507210E+01, 

DATA(AAHM(1,IP) 
DATA(AAHM(2, IP) 
DATA(BBHM(1, IP) 
DATA(BBHM(2, IP) 
DATA(DDXHM(1,IP 
DATA{DDXHM(2,IP 
DATA(DDYHM(1, IP 
DATA(DDYHM(2, IP 
DATA(WMAX(IP)  , 
1  13221./ 
DATA(VVMIN(IP)  , 
1  -14428. ,-13460 


471128E+03,  .293800E+03, 
360281E+02,  .133043E+02, 
816077E+00,  .439471E+01, 
.187325E+03/ 

, J=l,18)/ 

253611E+04,  .226837E+04, 
102002E+04,  .661878E+03, 
997819E+02,  .416119E+02, 
816077E+00,  .830522E+00, 
.672889E+02/ 

,J=1,18)/ 

508196E+04, 

218269E+04, 

260366E+03, 

439471E+01, 

.206029E+02/ 

,J=1,18)/ 

101809E+05, 

462762E+04, 

650553E+03, 

176082E+02, 

.507210E+01/ 

,J=1,18)/ 

203918E+05,  .186151E+05 
973844E+04,  .688612E+04 
157290E+04,  .816138E+03 
603802E+02,  .190939E+02 
.869857E+00/ 

,J=1,18)/ 

408366E+05,  .374743E+05 
203694E+05,  .147131E+05 
370647E+04,  .201755E+04 
187325E+03,  .672889E+02 
.869857E+00/ 


458082E+04, 

146420E+04, 

118840E+03, 

830522E+00, 


923904E+04, 

319336E+04, 

318704E+03, 

462415E+01, 


,165101E+03, 

,392321E+01, 

.176082E+02, 


.188083E+04, 

.391572E+03, 

.147120E+02, 

.462415E+01, 


.384866E+04, 
,903721E+03, 
,475361E+02, 
,  844251E+00, 


.785168E+04, 

.204248E+04, 

.139761E+03, 

.844251E+00, 


.159791E+05, 

.454057E+04, 

.384731E+03, 

.484985E+01, 


,324537E+05, 

.996084E+04, 

.100877E+04, 

.206029E+02, 


,IP=1,7)/17.45, 
,IP=1,7)/20.,16 
,IP=1,7)/14.26, 
, IP-1, 7)/16. 97, 
), IP-1, 7)/-2. 66 
),IP-l,7)/-3.3, 
),IP-1,7)/1.6, . 
), IP-1, 7) /I. 33, 
IP-1, 7)/34007., 


12.13,16.06,13.72,14.79,12 
.17,18.88,19.31,18.3,16.6, 
13.78,14.31,13.78,14.73,11 
16.7,17.07,17.23,17.93,17. 
,-5.53, -3. 19, -.11, -2. 45,-1 
-7. 45, -4. 1,-1. 76, -2. 77, -2. 

8.1.12. . 05. .48.3.4.1.22/ 
.32,1.54, .85,-69,1.86, .21/ 

55354..  14390.. 11287.. 9329. 


IP-1,7) /-42280., -16003., -60935., -16250., - 

./ 


DO  4  IP  -  1,7 
DO  3  N-1,2 

AHM(N, IP)  =  AAHM(N, IP) 
BHM(N,IP)  -  BBHM(N,IP) 
DXHM(N,IP)  =  DDXHM(N, IP) 
DYHM(N,IP)  -  DDYHM(N,IP) 
CONTINUE 

VMAX(IP)  -  VVMAX(IP) 
VMIN(IP)  -  WMIN(IP) 
CONTINUE 

INITIALIZE  COEF  FROM  UNIT  NTAPE 


DO  1  1-1,18 


MSM21130 
MSM21140 
MSM21150 
MSM21160 
MSM21170 
MSM21180 
MSM21190 
MSM21200 
MSM21210 
MSM21220 
MSM21230 
MSM21240 
MSM21250 
MSM21260 
MSM21270 
MSM21280 
MSM21290 
MSM21300 
MSM21310 
MSM21320 
MSM21330 
MSM21340 
MSM21350 
MSM21360 
MSM21370 
MSM21380 
MSM21390 
MSM21400 
MSM21410 
MSM21420 
MSM21430 
MSM21440 
MSM21450 
MSM21460 
MSM21470 
.82,15./  MSM21480 

17.93/  MSM21490 

.70,12.07/MSM21500 
5,16.6/  MSM21510 

.65,-2.23/MSM21520 
98,-3.14/  MSM21530 
MSM21540 
MSM21550 
.13249.,  MSM21560 

MSM21570 
12947.,  MSM21580 

MSM21590 
MSM21600 
MSM21610 
MSM21620 
MSM21630 
MSM21640 
MSM21650 
MSM21660 
MSM21670 
MSM21680 
MSM21690 
MSM21700 
MSM21710 
MSM21720 
MSM21730 
MSM21740 
MSM21750 
MSM21760 


ooooooo  oo  oooo 


msml.for 


2 

1 


DO  2  J=l,18 
COEFd,  J) 
XCO{I,J)  ■ 
CONTINUE 
CONTINUE 


-  0. 

YCOd,  J) 


OPEN  FILE  TO  GET  ELECTRIC  FIELD  COEFFICIENTS 
OPEN (UNIT=NTAPE, FILE=' EFCOEF' , STATUS='OLD' ) 

DO  81  IA=1,IPATT 

READ (NTAPE ,400, ERR=1 001,  END=1 001) MLBL 
1001  CONTINUE 

400  FORMAT (A) 

82  READ (NTAPE, *)NNN,MMM, I, J,CCF 
WRITE (8, 100)  IA,NNN,MMM, I, J,CCF 
100  FORMATdH  , 'IA,NNN,MMM,  I,  J,CCF  =  ',5I4,E15.5) 

IF(NNN.EQ.-l)  GO  TO  81 
IFd.GT.18.0R.  J.GT.18)  THEN 
WRITE(6,737)  IA,NNN,MMM, I, J 

737  FORMATdH  ,  '  OUT  OF  BOUNDS  IN  INPUT .  lA,  NNN,  MMM,  I,  J  =  ',515) 

END  IF 

COEFd,  J)=CCF 
GO  TO  82 
81  CONTINUE 

WRITE(8,401)MLBL 

401  FORMATdH  ,'MLBL  =  ',  5A10) 

NMAX=NNMAX 

CLOSE (NTAPE) 

RETURN 

END 


SUBROUTINE  BTRACE (LATDIM, LTDIM, ITMDIM, L, FSTOFF, FEQEDG, FDST, 

2  FCLPSE, FTILT, VM, BMIN, XMIN, YMIN, ZMIN, R, P , ALOCT, TETA) 


C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


VERSION  2.02 


DATE:  09.16.89 


PURPOSE:  SUBROUTINE  TO  CALCULATE  B  FIELD  MODELS  APPROPRIATE  FOR 

GEOPHYSICAL  CONDITIONS  AS  SPECIFIED  IN  BFPAR.  BTRACE 
CALCULATES  VM,  BMIN,  XMIN,  YMIN,  AND  ZMIN  ON  THE  MSM  SPATIAL 
GRID  BY  INTERPOLATING  BETWEEN  PRECOMPUTED  MAGNETIC  FIELD 
MODELS  AS  PARAMETERIZED  BY  THE  VARIABLES  OF  BFPAR. 


INPUT: 


LATDIM 

LTDIM 

ITMDIM 

L 


FSTOFF 

FEQEDG 

FDST 

FCLPSE 

FTILT 

ALOCT 

TETA 


OUTPUT : 

VM 


NUMBER  OF  LATITUDINAL  GRID  POINTS 

NUMBER  OF  LOCAL  TIME  GRID  POINTS  (INCL  WRAPAROUND) 
MAX  NUMBER  OF  TEMPORAL  GRID  POINTS 
CURRENT  TEMPORAL  GRID  INDEX 

GEOPHYSICAL  PARAMETERS  THAT  DETERMINE  WHICH  BFIELD 
MODELS  TO  USE 

STANDOFF  DIST  =  AUGPAR (STAND) 

EQUATORWARD  EDGE  OF  AURORA  =  AUGPAR (EQEDGE) 

DST  »  AUGPAR (DST) 

COLLAPSE  PARAMETER  =  AUGPAR (CLAPSE) 

TILT  PARAMETER  =  AUGPAR (TILTW) 

LOCAL  TIME  HOUR  ANGLE  (MEASURED  EAST  FROM  NOON) 
COLATITUDE  OF  I  GRID  LINES  (RADIANS) 


(FLUX  TUBE  VOLUME) **-2/3  ARRAY  (RE/NT) **-2/3 


MSM21770 

MSM21780 

MSM21790 

MSM21800 

MSM21810 

MSM21820 

MSM21830 

MSM21840 

MSM21850 

MSM21860 

MSM21870 

MSM21880 

MSM21890 

MSM21900 

MSM21910 

MSM21920 

MSM21930 

MSM21940 

MSM21950 

MSM21960 

MSM21970 

MSM21980 

MSM21990 

MSM22000 

MSM22010 

MSM22020 

MSM22030 

MSM22040 

MSM22050 

MSM22060 

MSM22070 

MSM22080 

MSM22090 

MSM22100 

MSM22110 

MSM22120 

MSM22130 

MSM22140 

MSM221S0 

MSM22160 

MSM22170 

MSM22180 

MSM22190 

MSM22200 

MSM22210 

MSM22220 

MSM22230 

MSM22240 

MSM22250 

MSM22260 

MSM22270 

MSM22280 

MSM22290 

MSM22300 

MSM22310 

MSM22320 

MSM22330 

MSM22340 

MSM22350 

MSM22360 

MSM22370 

MSM22380 

MSM22390 

MSM22400 


ooooo  ooooo  ooo 


BMIN 

XMIN 

YMIN 

ZMIN 

R 

P 


WORK: 


msml.for 

B  VALUE  AT  MINIMUM  VALUE  ALONG  FIELD  LINE  (NT) 

X  (GSM)  VALUE  AT  WHICH  BMIN  OCCURS 
Y  (GSM)  VALUE  AT  WHICH  BMIN  OCCURS 
Z  (GSM)  VALUE  AT  WHICH  BMIN  OCCURS 
R  SQRT(X**2+Y**2+Z**2)  AT  WHICH  BMIN  OCCURS 
HOUR  ANGLE  (RADIANS)  MEASURED  EASTWARD  FROM  NOON 


WORK  ARRAY  (NEEDED  FOR  BFIELD  RETRIEVAL  AND 
INTERPOLATION) 


REFERENCE: 

FIVE  DIMENSIONAL  INTERPOLATION  IS  BASED  ON  MULTILINEAR 
INTERPOLATION  SCHEME  GIVEN  BY  PRESS  ET  AL.  IN 
NUMERICAL  RECIPES,  CAMBRIDGE  UNIVERSITY  PRESS,  1987, PP  95' 


PROGRAMMER:  R.W.  SPIRO 


PARAMETER (IIDIM=62, JJDIM=51 ) 

COMMON  /GRID/DLAM,DPSI,RI, JWRAP 

LOGICAL*!  BFEXST(2,2,2,2,2) 

DIMENSION  WORK ( I IDIM, J JDIM, 2 , 2 , 2 ,  2 , 2 ) 

DIMENSION  VM(LATDIM,LTDIM, ITMDIM) 

DIMENSION  BMIN (LATDIM, LTDIM) , XMIN (LATDIM, LTDIM) 
DIMENSION  YMIN (LATDIM, LTDIM) , ZMIN (LATDIM, LTDIM) 
DIMENSION  ALOCT (LATDIM, LTDIM) , R (LATDIM, LTDIM, ITMDIM) 
DIMENSION  P (LATDIM, LTDIM, ITMDIM) 

DIMENSION  BFLIM(2, 5) ,BFPAR(5) 

DIMENSION  T(2,5),N(5) 

DIMENSION  SUMC ( I IDIM, JJDIM) 

DIMENSION  TETA (LATDIM) 

DATA  BFBUSH  /1.E20/ 


CHECK  DIMENSIONS 

IF ( I IDIM . NE . LATDIM . OR . JJDIM . NE . LTDIM)  THEN 
WRITE (6,*)  'DIMENSION  ERROR  IN  BTRACE' 

WRITE (6,*)  'IIDIM=  ',IIDIM, '  SHOULD  EQUAL  LATDIM=  ', LATDIM 
WRITE(6,*)  'JJDIM=  ', JJDIM, '  SHOULD  EQUAL  LTDIM=  LTDIM 
WRITE (6,*)  'STOPPING  PGM  IN  BTRACE;  CHECK  DIMENSIONS' 

STOP 
END  IF 


PI-ATAN2(0.,-1.) 

SET  UP  BFPAR  VECTOR  FOR  CALLING  GETMAT 
BFPAR(l)»FSTOFF 
BFPAR (2) -FT I LT 
BFPAR(3)-FEQEDG 
BFPAR(4)=FDST 
BFPAR(5)-FCLPSE 


INITIALIZE  BFIELD  ARRAYS 


MSM22410 
MSM22420 
MSM22430 
MSM22440 
MSM22450 
MSM22460 
MSM22470 
MSM22480 
MSM22490 
MSM22500 
MSM22510 
MSM22520 
MSM22530 
MSM22540 
-97  MSM22550 
MSM22560 
MSM22570 
MSM22580 
MSM22590 
MSM22600 
MSM22610 
MSM22620 
MSM22630 
MSM22640 
MSM22650 
MSM22660 
MSM22670 
MSM22680 
MSM22690 
MSM22700 
MSM22710 
MSM22720 
MSM22730 
MSM22740 
MSM22750 
MSM22760 
MSM22770 
MSM22780 
MSM22790 
MSM22800 
MSM22810 
MSM22820 
MSM22830 
MSM22840 
MSM22850 
MSM22860 
MSM22870 
MSM22880 
MSM22890 
MSM22900 
MSM22910 
MSM22920 
MSM22930 
MSM22940 
MSM22950 
MSM22960 
MSM22970 
MSM22980 
MSM22990 
MSM23000 
MSM23010 
MSM23020 
MSM23030 
MSM23040 


ooo  oooooo  oo  oooo  o  non  non  no 


msml.for 


DO  15  J=1,LTDIM 

DO  16  I-1,LATDIM 
VM(I,  J,L)=0. 

BMINd,  J)=0. 

XMINd,  J)=0. 

YMINd,  J)=0. 

ZMINd,  J)=0. 

SUMCd,  J)=0. 

16  CONTINUE 
15  CONTINUE 
C 

WRITE  (6,*)  'GETMAT  IS  REQUESTING  THE  FOLLOWING  B-MATRICES:' 

LOOP  OVER  FIVE  FLAVORS  OF  B  FIELD  ARRAYS 
DO  20  NN-1,5 
IWANT»NN 

CALL  GETMAT  TO  READ  APPROPRIATE  ARRAYS  FOR  INTERPOLATION 

CALL  GETMAT (IWANT, LATDIM, LTDIM, BFPAR, WORK, BFLIM, BFEXST) 

CALL  RMVBSH (WORK, LATDIM, LTDIM) 

SET  UP  WEIGHTING  PARAMETERS  FOR  INTERPOLATION 

DO  10  11=1,5 

T(2, II) = (BFPAR (ID -BFLIM (1, II) )/ (BFLIM (2, II) -BFLIM (1, II ) ) 
Td,II)=l.-T(2,II) 

10  CONTINUE 

IFdWANT.EQ.l)  THEN 

WRITE(6,*)  'T  ARRAY', T 
END  IF 


MAIN  INTERPOLATION  LOOPS 

DO  21  Nl=l,2 
Nd)=Nl 
DO  22  N2=l,2 
N(2)=N2 
DO  23  N3«l,2 
N(3)=N3 
DO  24  N4=l,2 
N(4)=N4 
DO  25  N5=l,2 
N(5)=N5 

COEFF=l . 

DO  30  M=l,5 

COEFF=COEFF*T (N (M)  , M) 

30  CONTINUE 

CHECK  TO  SEE  IF  B  FIELD  MODEL  EXISTS 

WRITE (6, *)  'N1,N2,N3,N4,N5' ,N1,N2,N3,N4,N5 
WRITE (6,*)  'COEFF' ,COEFF 

WRITE (6, *)  'BFEXST' , BFEXST (Nl,N2,N3,N4,N5) 
IF (.NOT. BFEXST (N1,N2,N3,N4,N5) )  THEN 
COEFF=0 . 

END  IF 


MSM23050 

MSM23060 

MSM23070 

MSM23080 

MSM23090 

MSM23100 

MSM23110 

MSM23120 

MSM23130 

MSM23140 

MSM23150 

MSM23160 

MSM23170 

MSM23180 

MSM23190 

MSM23200 

MSM23210 

MSM23220 

MSM23230 

MSM23240 

MSM23250 

MSM23260 

MSM23270 

MSM23280 

MSM23290 

MSM23300 

MSM23310 

MSM23320 

MSM23330 

MSM23340 

MSM23350 

MSM23360 

MSM23370 

MSM23380 

MSM23390 

MSM23400 

MSM23410 

MSM23420 

MSM23430 

MSM23440 

MSM23450 

MSM23460 

MSM23470 

MSM23480 

MSM23490 

MSM23500 

MSM23510 

MSM23520 

MSM23530 

MSM23540 

MSM23550 

MSM23560 

MSM23570 

MSM23580 

MSM2359b 

MSM23600 

MSM23610 

MSM23620 

MSM23630 

MSM23640 

MSM23650 

MSM23660 

MSM23670 

MSM23680 


o  o 


msml.for 


OVER  SPATIAL  GRID 


IF(IWANT.EQ.l)  THEN 
DO  40  J=1,LTDIM 

DO  50  I=1,LATDIM 

IF(WORK(I, J,N1,N2,N3,N4,N5) .LT.BFBUSH)  THEN 
XMIN ( I , J) =XMIN ( I , J) +COEFF* 

WORKd,  J,N1,N2,N3,N4,N5) 

END  IF 
CONTINUE 
CONTINUE 

WRITE (6,*)'  XMIN  VALUES' 

WRITE(6,*)  (XMINd, 33)  ,1=20,26) 

WRITE(6,*) (XMIN (I, 12), 1=20, 26) 

WRITE (6,*)'  WORK  VALUES  ' 

WRITE  (6,*)  (WORK  d,  33, N1,N2,N3,N4,N5)  ,1=20,26) 
WRITE (6,*) (WORK (I, 12, N1,N2,N3,N4,N5) ,1=20,26) 
WRITE(6, *)N1,N2,N3,N4,N5 

ELSE  1F(IWANT.EQ.2)  THEN 
DO  60  J=1,LTDIM 

DO  70  I=1,LATDIM 

IF(WORK(I, J,N1,N2,N3,N4,N5) .LT.BFBUSH)  THEN 
YMIN (I , J) =yMlN (I , J) +COEFF* 

WORKd,  J,N1,N2,N3,N4,N5) 

END  IF 
CONTINUE 
CONTINUE 

ELSE  IF(IWANT.EQ.3)  THEN 
DO  80  J=1,LTDIM 

DO  90  I=1,LATDIM 

IF(WORK(I, J,N1,N2,N3,N4,N5) .LT.BFBUSH)  THEN 
2MIN ( I , J) =ZMIN (I , J) +COEFF* 

WORKd,  J,N1,N2,N3,N4,N5) 

END  IF 
CONTINUE 
CONTINUE 

ELSE  IF(IWANT.EQ.4)  THEN 
DO  100  J=1,LTDIM 

DO  110  I=1,LATDIM 

IF  (WORKd,  J,N1,N2,N3,N4,N5)  .LT.BFBUSH)  THEN 
BMINd,  J)=BMIN(I,  J)+COEFF* 

WORKd,  J,N1,N2,N3,N4,N5) 

END  IF 
CONTINUE 
CONTINUE 

ELSE 

DO  120  J=1,LTDIM 

DO  130  I=1,LATDIM 

IF(WORK(I, J,N1,N2,N3,N4,N5) .LT.BFBUSH)  THEN 
VM (I , J, L) =VM (I , J, L) +COEFF* 

WORKd,  J,N1,N2,N3,N4,N5) 

SUMC ( I , J) =SUMC (I ,  J) +COEFF 
END  IF 
CONTINUE 
CONTINUE 
ENDIF 
CONTINUE 
CONTINUE 
CONTINUE 
CONTINUE 
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msml.for 

CONTINUE 
20  CONTINUE 

CALL  OUTP (SUMC, IIDIM, JJDIM, 10, IIDIM, 1, 3, JJDIM-3, 1, 1 . , ' SUMC' , 6, 

CORRECT  FOR  MISSING  B  FIELD  MATRICES 

DO  140  J=1,LTDIM 

DO  150  I=1,LATDIM 

IF(SUMC(1, J) .GT.l.E-10)  THEN 

VM{I, J,L)“VM{I, J,L) /SUMC (I, J) 

BMINd,  J)=BMIN(I,  J)  /SUMC  (I,  J) 

XMINd,  J)=XMIN(I,  J)  /SUMC  (I,  J) 

YMINd,  J)=YMINd,  J)  /SUMC  (I,  J) 

ZMINd,  J)=ZMINd,  J)  /SUMC  (I,  J) 

END  IF 

150  CONTINUE 
140  CONTINUE 


ROTATE  BFIELD  ARRAYS  TO  MATCH  GRID  ORIENTATION 

NOTE:  IN  THE  CALLS  TO  BFGYRO,  R  IS  BEING  USED  AS  A  WORK  ARRAY 

CALL  BFGYRO (LATDIM, LTDIM, VM (1 , 1 , L) , R (1 , 1, L)  ,  ALOCT) 

CALL  BFGYRO(LATDIM,  LTDIM, BMIN, Rd, 1, L)  , ALOCT) 

CALL  BFGYRO (LATDIM, LTDIM, XMIN, R{1, 1, L) , ALOCT) 

CALL  BFGYRO (LATDIM, LTDIM, YMIN, R ( 1 , 1 , L) , ALOCT) 

CALL  BFGYRO (LATDIM, LTDIM, ZMIN,R(1,1,L) , ALOCT) 


DO  160  J=l, LTDIM 

DO  170  1=1, LATDIM 

R(I,  J,L)=SQRT  (XMINd,  J)  **2+YMIN(I,  J)  **2+ZMIN(I,  J)  **2) 

C 

IF(XMIN(I, J) .EQ.O. . AND. YMIN (I,J) .EQ.O. )  THEN 
P(I,  J,L)-0. 

ELSE 

P  (I,  J,L)=ATAN2  (YMINd,  J)  ,XMIN(I,  J)  ) 

IF(P(I, J, L) .LT.O.)  THEN 
Pd,  J,L)=P  (I,  J,L)+2.*PI 
END  IF 
END  IF 
C 

170  CONTINUE 
160  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  BFGYRO (LATDIM, LTDIM, ARRAY, WORK, ALOCT) 

C 

C  VERSION  1.00  DATE:  08.29.89 

C 

C  PURPOSE:  SUBROUTINE  TO  ROTATE  FIXED  GRID  B  FIELD  ARRAYS  TO  MATCH 
C  ROTATING  COORDINATE  SYSTEM 

C 

C  NOTE:  THIS  SUBROUTINE  USES  ARRAY  AS  BOTH  AN  INPUT  AND  OUTPUT 
C  ARRAY.  ON  INPUT,  ARRAY  CONTAINS  THE  UNROTATED  DATA;  ON 

C  OUTPUT,  IT  CONTAINS  THE  APPROPRIATELY  ROTATED  DATA. 

C 

C  INPUTS : 

C  LATDIM  NUMBER  OF  LATITUDINAL  GRID  LINES 

C  LTDIM  NUMBER  OF  LOCAL  TIME  (LONGITUDE)  GRID  LINES 


MSM24330 

MSM24340 

MSM24350 

132)MSM24360 

MSM24370 

MSM24380 

MSM24390 

MSM24400 

MSM24410 

MSM24420 

MSM24430 

MSM24440 

MSM24450 

MSM24460 

MSM24470 

MSM24480 

MSM24490 

MSM24500 

MSM24510 

MSM24520 

MSM24530 

MSM24540 

MSM24550 

MSM24560 

MSM24570 

MSM24580 

MSM24590 

MSM24600 

MSM24610 

MSM24620 

MSM24630 

MSM24640 

MSM24650 

MSM24660 

MSM24670 

MSM24680 

MSM24690 

MSM24700 

MSM24710 

MSM24720 

MSM24730 

MSM24740 

MSM24750 

MSM24760 

MSM24770 

MSM24780 

MSM24790 

MSM24800 

MSM24810 

MSM24820 

MSM24830 

MSM24840 

MSM24850 

MSM24860 

MSM24870 

MSM24880 

MSM24890 

MSM24900 

MSM24910 

MSM24920 

MSM24930 

MSM24940 

MSM24950 

MSM24960 


on  on  oooo  o  non 


C 

C 

C 

c 

c 

c 

c 

c 

c 


ARRAY 

WORK 

ALOCT 


OUTPUT: 

ARRAY 


msml.for 

UNROTATED  MAGNETIC  FIELD  ARRAY 
INTERNAL  WORKING  ARRAY 

LOCAL  TIME  HOUR  ANGLE  (MEASURED  EAST  FROM  NOON) 
(RADIANS) 


ROTATED  MAGNETIC  FIELD  ARRAY 


COMMON  /GRID/DLAM,DPSI,RI, JWRAP 


C 


DIMENSION  ARRAY (LATDIM, LTDIM) , WORK (LATDIM,  LTDIM) 
DI^ffiNSION  ALOCT (LATDIM, LTDIM) 


PI»ATAN2(0.,-1.) 


CALCULATE  ROTATION  OF  COORDINATE  SYSTEM 


ROT“ALOCT(l, 3) * (LTDIM-JWRAP) / (2. *PI) 

JROT-ROT 

F-ROT-FLOAT ( JROT) 

DO  10  J-1, LTDIM 
Jl-J+JROT 

Jl-MOD (Jl, LTDIM-JWRAP) 

IF(J1.EQ,0)  Jl “LTDIM-JWRAP 
J2=J1+1 

DO  20  I“l, LATDIM 

WORKd,  J)  =  (l.-F)  *ARRAY(I,  J1)+F*ARRAY(I,  J2) 
20  CONTINUE 
10  CONTINUE 


PUT  ROTATED  ARRAY  BACK  INTO  ARRAY 

DO  30  J=l, LTDIM 

DO  40  1*1, LATDIM 

ARRAY ( I , J) “WORK ( I ,  J) 

40  CONTINUE 
30  CONTINUE 


RETURN 

END 


C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 


SUBROUTINE  PPTM (TSTART, TSTOP, DTNOM, SCTFRC, IFLAV, BNDMAX, 

1  ALPHA, BETA, BIR, ITMMAX, IDIM, JDIM, lEDIM, ITMDIM, IRDIM, 

2  NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXR, FLXNRG, FLXKP, FLXMAT, 

3  THRMAT, TIMTAG, ALAM, ALMDEL, VM, R, P, VMLOSS, V, ETABEG, 

4  ETABND, BNDLOC, ETA, EFLUX, FLXSUM, EAVG, LL, RPP, FKP, 

5  lEMAX, THRSH, TSHENG, TSHING, IRDK, INRGDK, ISOLDK, lONDK, 

6  DKTIME) 


VERSION  1.00 
1.10 
1.20 
1.30 


DATE:  01.07.88 
09.12.89 
10.10.89 
05.09.90 


PURPOSE:  SUBROUTINE  TO  TRACE  7ARTICLE  TRAJECTORIES  FROM  EACH  GRID 

POINT  FOR  EACH  PARTICLE  SPECIES  BACK  IN  TIME  FROM 
TIME=TSTART  TO  TIME=TSTOP.  LOSS  BY  PRECIPITATION  INTO 
THE  LOSS  CONE  IS  CALCULATED  FOR  EACH  TEST  PARTICLE  ALONG 
ITS  TRAJECTORY.  PARTICLE  DISTRIBUTIONS  AND  PRECIPITATING 


MSM24970 

MSM24980 

MSM24990 

MSM25000 

MSM25010 

MSM25020 

MSM25030 

MSM25040 

MSM25050 

MSM25060 

MSM25070 

MSM25080 

MSM25090 

MSM25100 

MSM25110 

MSM25120 

MSM25130 

MSM25140 

MSM25150 

MSM25160 

MSM25170 

MSM25180 

MSM25190 

MSM25200 

MSM25210 

MSM25220 

MSM25230 

MSM25240 
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MSM25310 

MSM25320 
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MS.'I25340 
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MSM25360 

MSM25370 

MSM25380 
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MSM25430 
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MSM25450 
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MSM25590 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


ENERGY  FLUXES  ARE  CALCULATED  AT  EACH  GRID  POINT  FOR  TIME 
TSTART  FROM  INITIAL  AND  BOUNDARY  VALUES  AT  TIME  TSTOP . 
NOTE:  TSTART. GT. TSTOP 


INPUT: 

TSTART 

TSTOP 

DTNOM 


SCTFRC 

IFLAV 

BNDMAX 

ALPHA 

BETA 

BIR 

ITMMAX 

IDIM 

JDIM 

lEDIM 

ITMDIM 

IRDIM 

NRGDIM 

KPDIM 

KPPLUS 

ISPDIM 

FLXR 

FLXNRG 

FLXKP 

FLXMAT 

THRMAT 

TIMTAG 

ALAM 

ALMDEL 

VM 

R 

P 

VMLOSS 

V 

ETABEG 

ETABND 

BNDLOC 

LL 

RPP 

FKP 

lEMAX 

THRSH 

TSHENG 

TSHING 

IRDK 

INRGDK 

ISOLDE 

lONDK 

DKTIME 


TIME  AT  WHICH  TO  BEGIN  PARTICLE  TRACEBACK 
TIME  AT  WHICH  TO  END  PARTICLE  TRACEBACK 
NOMINAL  TIME  STEP  TO  BEGIN  TRACES.  DTNOM. LT.O 
TO  TRACE  BACK  IN  TIME.  PPTM  WILL  ADJUST 
TIME  STEP  AS  NEEDED. 

SCATTERING  FRACTION  OF  STRONG  PITCH  ANGLE  DIFFUSION 

SPECIES  DEFINITION  INDEX.  1FLAV=1  FOR  ELECTRONS 

IFLAV=2  FOR  H+  IONS;  IFLAV=3  FOR  0+  IONS 

MAX  I  VALUE  OF  BNDY  IN  TIME  INTERVAL 

LATITUDINAL  GRID  SPACING  VECTOR 

LOCAL  TIME  GRID  SPACING  VECTOR 

lONSOPHERIC  MAGNETIC  FIELD  STRENGTH 

NUMBER  OF  TEMPORAL  GRID  POINTS  USED 

NUMBER  OF  LATITUDINAL  GRID  POINTS 

NUMBER  OF  LOCAL  TIME  GRID  POINTS  (INCL  WRAPAROUND) 

NUMBER  OF  ENERGY  SPECIES 

MAX  NUMBER  OF  TEMPORAL  GRID  POINTS 

R  DEPTH  IN  FLXMAT  ARRAY 

ENERGY  DEPTH  IN  FLXMAT  ARRAY 

KP  DEPTH  IN  FLXMAT  ARRAY 

.^UGMENTED  KP  DIMENSION  OF  FLXMAT  {KPDIM+2) 

NUMBER  OF  MASS  SPECIES  IN  FLXMAT  ARRAY 
ALOGIO(R)  VALUES  FOR  WHICH  FLXMAT  ARRAY  IS 
CALCULATED 

ALOGIO (ENERGY)  VALUES  FOR  WHICH  FLXMAT  ARRAY  IS 
CALCULATED 

KP  VALUES  FOR  WHICH  FLXMAT  ARRAY  IS  CALCULATED 

ALOGIO (FLUX)  FOR  A  GIVEN  R,ENERGY,  AND  KP 

ARRAY  GIVING  LOG  OF  THRESHOLD  FLUXES 

VECTOR  GIVING  UNIVERSAL  TIMES  FOR  WHICH  DATA  ARRAYS 

ARE  GIVEN.  (SECONDS  FROM  BEGINNING  OF  START  DAY) 

ENERGY  INVARIANT  OF  PARTICLE 

ENERGY  INVARIANT  SPACING 

(FLUX  TUBE  VOLUME)  **-2/3  ARRAY  (RE/NT)  **-')/ 3 
DISTANCE  TO  BMIN  PT  (RE) 

HOUR  ANGLE  (EASTWARD  FROM  NOON)  (RADIANS) 

AUX.  LOSS  ARRAY=  (SINI/BIR) *VM**2 
ELECTRIC  POTENTIAL  ARRAY  (VOLTS) 

INITIAL  ETA  DISTRIBUTION  (IE.,  AT  T=TSTOP) 

ETA  DISTRIBUTION  ON  BOUNDARY  (DEPENDS  ON  TIME) 

OUTER  BNDY  OF  CALCULATION  (DEPENDS  ON  TIME) 

CURRENT  TEMPORAL  GRID  INDEX 
NOMINAL  RADIUS  OF  PLASMAPAUSE 
CURRENT  KP  VALUE 

NUMBER  OF  ENERGY  CHANNELS  BEING  USED 
VECTOR  GIVING  FULL  TRACE/DEFAULT  FLUX  INFORMATION 
THRESHOLD  ENERGY  FOR  SWITCHING  FROM  FULL  TRACE 
TO  EMPIRICAL  MODEL  FOR  ELECTRONS 

THRESHOLD  ENERGY  FOR  SWITCHING  FROM  FULL  TRACE  TO 

EMPIRICAL  MODEL  FOR  IONS 

R  DIMENSION  FOR  DKTIME  ARRAY 

ENERGY  DIMENSION  FOR  DKTIME  ARRAY 

SUN  SPOT  NUMBER  DIMENSION  FOR  DKTIME  ARRAY 

NUMBER  OF  ION  SPECIES  IN  DKTIME  ARRAY 

TABLE  OF  ION  CHARGE  EXCHANGE  DECAY  TIMES 


OUTPUT : 

ETA  COMPUTED  ETA  DISTRIBUTION  CORRESPONDING  TO  T=TSTART 

EFLUX  PRECIPITATING  ENERGY  FLUX  FOR  EACH  SPECIES 
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MSM26020 
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MSM26040 

MSM26050 

MSM26060 

MSM26070 

MSM26080 

MSM26090 

MSM26100 

MSM26110 

MSM26120 

MSM26130 

MSM26140 

MSM26150 

MSM26160 

MSM26170 

MSM26180 

MSM26190 

MSM26200 

MSM26210 

MSM26220 

MSM26230 

MSM26240 


ooon  oooo 


FLXSUM 


PROGRAMMER: 


msml.for 

TOTAL  PRECIPITATING  ENERGY  FLUX  FOR:  (1)  ELECTRONS; 

(2)  H+  IONS;  AND  (3)  0+  IONS 
AVERAGE  ENERGY  OF  PRECIPITATING  PARTICLES  FOR: 

(1)  ELECTRONS;  (2)  H+  IONS;  AND  (3)  0+  IONS 

.  SPIRO 


PARAMETER (IKDIM=3,IIDIM=62, J JDIM=5 1 , KKD IM=  3  0 , MD IM=1 000) 

COMMON  /GRID/  DLAM, DPSI, RI , JWRAP 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN,  LUYMIN, LUZMIN,  LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
COMMON  /MOVE/  IBEG, ISTOP, JBEG, JSTOP, lEBEG, lEEND 

COMMON  /SUN/  SSN 
COMMON / TMP  6/III,JJJ 

DIMENSION  ALPHA (IDIM) ,  BETA(IDIM),  BIR (IDIM, JDIM) 

DIMENSION  V (IDIM, JDIM, ITMDIM) , VM (IDIM, JDIM, ITMDIM) , TIMTAG (ITMDIM) 
DIMENSION  R(IDIM, JDIM, ITMDIM) , P (IDIM, JDIM, ITMDIM) 

DIMENSION  IFLAV (lEDIM) , BNDLOC (JDIM, ITMDIM) , THRSH (lEDIM) 

DIMENSION  SCTFRC ( lEDIM, JDIM, ITMDIM) , RPP (ITMDIM) 

DIMENSION  BNDMAX(JDIM) 

DIMENSION  VMLOSS (IDIM, JDIM, ITMDIM) , ETABEG (IDIM, JDIM, lEDIM) 
DIMENSION  ETABND (JDIM, lEDIM, ITMDIM) , ETA (IDIM, JDIM, lEDIM) 

DIMENSION  EFLUXdDIM,  JDIM,  lEDIM) 

DIMENSION  FLXSUM (IDIM, JDIM, IKDIM) ,  EAVG (IDIM, JDIM, IKDIM) 

DIMENSION  SUMl (IKDIM) , SUM2 (IKDIM) 

DIMENSION  XMASS (IKDIM) 

DIMENSION  ALAM(IEDIM) ,ALMDEL(IEDIM) 

DIMENSION  FLXRFF (IIDIM, JJDIM, KKDIM) 

DIMENSION  DENSUMdIDIM,  JJDIM,  IKDIM) 

DIMENSION  FLXMAT (IRDIM, NRGDIM, KPPLUS, ISPDIM) 

DIMENSION  THRMAT (IRDIM, NRGDIM, KPDIM) 

DIMENSION  FLXR (IRDIM) , FLXNRG (NRGDIM)  ,  FLXKP (KPDIM) 

DIMENSION  TM (MDIM) , BIM (MDIM) , BJM (MDIM) , WEAK (MDIM) , STRONG (MDIM) 
DIMENSION  RR (MDIM) ,PP (MDIM) ,VVM (MDIM) 

DATA  XMASS  /9 . llE-31, 1 . 67E-27, 2 . 67E-26/ 

DATA  EPS,BBISCL,BBJSCL  /.Ol,l.,l./ 

DATA  VMGEO/7.0/ 


CHECK  DIMENSION  COMPATIBILITY 

IF (I IDIM . NE . IDIM . OR . JJDIM . NE . JDIM . OR . KKDIM . LT . lEMAX )  THEN 
WRITE (6,*)  'DIMENSION  COMPATIBILITY  PROBLEMS  IN  PPTM' 

WRITE (6,*)  'IIDIM=  ',IIDIM, '  SHOULD  BE  EQUAL  TO  IDIM=  ' , IDIM 
WRITE (6,*)  'JJDIM=  ', JJDIM, '  SHOULD  BE  EQUAL  TO  JDIM=  ' , JDIM 
WRITE (6, *) ' IEMAX=  ' , lEMAX, '  SHOULD  BE  LESS  THAN  KKDIM=  ', KKDIM 
WRITE (6,*)  'STOPPING  PGM  IN  PPTM' 

STOP 
END  IF 


PI-ATAN2 (0. ,-l. ) 


MSM26250 
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MSM26490 

MSM26500 

MSM26510 
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MSM26680 
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MSM26720 

MSM26730 

MSM26740 

MSM26750 

MSM26760 

MSM26770 

MSM26780 

MSM26790 

MSM26800 

MSM26810 

MSM26820 

MSM26830 

MSM26840 

MSM26850 

MSM26860 

MSM26870 

MSM26880 
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C  CALCULATE  REFERENCE  FLUX  ARRAY  FOR  TIME=TSTART 

CALL  SETREF (IDIM, JDIM, lEDIM, ITMDIM, ITMMAX, IRDIM, NRGDIM, KPDIM, 

2  KPPLUS, ISPDIM, TIMTAG, TSTART, IFLAV, VM, R, P, BNDLOC, ALAM, 

3  ALMDEL, FLXMAT, FLXR, FLXNRG,  FLXKP, FLXREF, lEMAX) 

C 

C  DEBUG  PRINTOUT 

C  DO  400  IE=1,IEMAX 

C  WRITE (6,*)  'IE=  ',IE 

C  CALL  OUTP(FLXREF<1,1,IE),IDIM,JDIM,20,IDIM,1,3, JDIM-1,1,0., 

C  2  'FLXREF', 6, 132) 

C  400  CONTINUE 

C 

C 

C 

C 

JMID= ( JDIM-3) /2+3 
ETAEQK  =  0. 

INITIALIZE  FLXSUM  AND  DENSUM 
DO  100  1=1, IDIM 

DO  100  J=1,JDIM 

DO  110  IK=1,IKDIM 

1K=1  FOR  ELECTRONS;  IK=2  FOR  H+  IONS;  IK=3  FOR  0+  IONS 
FLXSUMd,  J,IK)=0. 

DENSUMd,  J,IK)=0. 

110  CONTINUE 

INITIALIZE  EFLUX 

DO  120  IE=1,IEMAX 
EFLUXd,  J,IE)=0. 

120  CONTINUE 

100  CONTINUE 


DO  10  LOOP  GOES  OVER  PARTICLE  SPECIES  TO  BE  TRACED 

DO  10  IE=IEBEG, lEEND 
C 

C  FOR  ELECTRONS  WITH  ENERGY  GREATER  THAN  TSHENG  KEV  AT 
C  GEOSYNCHRONOUS  ORBIT,  USE  EMPIRICAL  FLUXES  AND  DISREGARD  FULL 
C  TRACEBACKS.  SIMILARLY  FOR  IONS  GREATER  THAN  TSHING  KEV 
C 

HIENG= (ABS (ALAM (IE) ) *VMGEO) /lOOO.  0 

IF( (HIENG.GE. TSHENG) .AND. (IFLAV(IE) .EQ.l) ) THEN 

CALL  FLXDFL (LL, FKP, R, P, ALAM, VM, IRDIM, NRGDIM, KPDIM, KPPLUS, 

1  ISPDIM, FLXMAT, FLXR, FLXNRG, FLXKP, EFLUX, ETA, ALMDEL, IDIM, JDIM, 

2  lEDIM, ITMDIM, BNDLOC, lEMAX, IFLAV, IE, IE) 

THRSH(IE)=TSHENG 

IEUSE=IE 
GO  TO  10 
ENDIF 
C 

IF( (HIENG.GE. TSHING) .AND. dFLAV(IE) .NE.l) ) THEN 

CALL  FLXDFL ( LL, FKP , R, P , ALAM, VM, IRDIM, NRGDIM, KPDIM, KPPLUS , 

1  ISPDIM, FLXMAT, FLXR, FLXNRG, FLXKP, EFLUX, ETA, ALMDEL, IDIM, JDIM, 

2  lEDIM, ITMDIM, BNDLOC, lEMAX, IFLAV, IE, IE) 

THRSH(IE)=TSHING 

IEUSE=IE 
GO  TO  10 
ENDIF 
C 

IK=IFLAV(IE) 

ISP=IK 
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MSM27190 
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MSM27280 

MSM27290 

MSM27300 
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MSM27440 
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non 


c 


c 

c 

c 

c 

c 

c 

c 

c 


c 


DO  20  I=IBEG,ISTOP 
II-l 

CALL  DTIME(ITRCST) 

DO  24  J=JBEG,JSTOP 
III=I 
JJJ=J 
JJ=J 

BBT=TNORML (TSTART, TIMTAG, ITMMAX) 

IBT=BBT 

BNDJT= (1 . -BBT+REAL (IBT) ) *BNDLOC ( JJ, IBT) 

1  + (BBT-REAL (IBT) ) *BNDLOC (JJ, IBT+1) 

IF (REAL(I) .LT.BNDJT)  THEN 

ETA(I, J,  IE)  =  (1 .-BBT+REAL (IBT) ) *ETABND(J, IE, IBT) 

1  + (BBT-REAL (IBT) ) *ETABND (J, IE, IBT+1 ) 

GO  TO  24 
END  IF 


TIME  LOOP  HAS  POSSIBILITY  FOR  VARYING  TIME  STEPS.  STOP  TRACING 
PARTICLE  TRAJECTORY  WHEN  (1)  BOUNDARY  IS  CROSSED  OR  (2)  TSTOP  IS 
REACHED . 

INITIALIZATION 

T=T START 
IT=NINT (T) 

DTNEXT=DTNOM 

FXLOSS=0. 

FXL2=0 . 

BBI=I 

BB.T=^J 

BBT=TNORML (T, TIMTAG, ITMMAX) 

M=1 

TM  (M)  =T 

BIM{M)=BBI 

BJM(M)*BBJ 

RR(M) =G3NTRP (R, IDIM, JDIM, ITMDIM, BBI , BBJ, BBT) 

PP (M) =G3TRPA (P, IDIM, JDIM, ITMDIM, BBI, BBJ, BBT) 

WM  (M)  =G3NTRP  (VM,  IDIM,  JDIM,  ITMDIM,  BBI,  BBJ,  BBT) 

RPPM=G3NTRP (RPP , ITMDIM, 1,1, BBT,  1 . ,  1 . ) 

ENRGM=ABS  (AALAM)  *WM  (M) 

IF(ISP.EQ.l)  THEN 

FZERO=G3NTRP (SCTFRC, lEDIM, JDIM, ITMDIM, FLOAT (IE) , BBJ, BBT) 
RATEF= (4 . 45E-17) *SQRT (ABS (AALAM) /XMASS (IK) ) *G3NTRP (VMLOSS, 
2  IDIM,  JDIM, ITMDIM, BBI, BBJ, BBT) 

STRONG (M) =FZERO*RATEF 

WEAK (M) “WKRATE (RR (M) , RPPM, PP (M) , ENRGM) 

ELSE 

STRONG (M) =0 . 

WEAK (M) =CEXRAT (ISP, ENRGM, RR(M) , SSN,DKTIME, IRDK, INRGDK, 

2  ISOLDK, lONDK) 

END  IF 
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nooo  o  o  nnnnnnnnnn  n  o  ooo 


msml.for 


DEBUG  1.5.90 
WRITE (6, 789) 

789  FORMAT (IX, ' ****************************************************' ) 
WRITE(6,790)  M,TM(M) ,BIM(M) , B JM (M) , RR (M) , PP (M) ,VVM(M) ,rppm,enrgm 

790  FORMATdX,  'M='  ,I3,2X,  'T='  ,F8.0,2X,'BI=',F6.3,2X,  'BJ=',F6.3,2X, 

2  ' R=' , F6 . 3, 2X, ' P=' , F8 . 3, 2X, ' VM=' , F8 . 3, 2X, ' RPP=' , F6 . 3, 2X, 

3  'ENRG=' ,1PE12.3) 

WRITE (6, 791)  M,T,RATEF, STRONG (M) ,WEAK{M) 

791  FORMATdX, 'DEBUG  1.5.90  M=' ,  15,  2X,  ' T=' ,  FIO .  0, 2X, 

2  ' RATEF=',1PE12. 3, 2X, 'STRONG  LOSS  RATE=' , E12 . 3, 2X, 

3  'WEAK  LOSS  RATE=' ,E12.3) 

BEGINNING  OF  TIME  LOOP 
30  CONTINUE 

MOVE  PARTICLE  A  TIME  STEP 

TOLD=T 

BIOLD=BBI 

BJOLD=BBJ 

DTTRY=DTNEXT 

IF(DTNOM.GT.O. . AND . DTTRY . GT . (TSTOP-TOLD) )  DTTRY"TSTOP-TOLD 
IF(DTNOM.LT.O. . AND . DTTRY . LT . (TSTOP-TOLD) )  DTTRY=TSTOP-TOLD 

IF(BIOLD.GT.REAL(IDIM)-l.)  THEN 
ETAd,  J,  IE)=0. 

GO  TO  24 
END  IF 

CALL  MOVER (T, DTTRY, BIOLD, BJOLD, EPS, BBISCL, BBJSCL, DTUSED, DTNEXT, 

1  AALAM, V, VM, TIMTAG, ALPHA, BETA, BIR, IDIM, JDIM, ITMDIM, BBI , BB J) 

DEBUG  PRINTOUT  12.29.89 

WRITE (6, 888)  IE, T, DTTRY, BIOLD, BJOLD, DTUSED, BBI, BBJ 
888  FORMATdX,  'IE='  ,I2,2X,  'T='  ,  FIO  .  2, 2X, '  DTTRY=' ,  F5 . 0, 2X, '  BIOLD='  , 

2  F6.2,2X, 'BJOLD=' ,F6.2,2X, 'DTUSED=' ,F5.0,2X, 'NEW  BI=',F6.2, 

3  2X, 'NEW  BJ=' ,F6.2) 


IT-IT+NINT (DTUSED) 

T=REAL(IT) 

BBT-TNORML (T, TIMTAG, ITMMAX) 

M=M+1 

BIM(M)=BBI 
BJM (M) =BBJ 

CALL  MODFIX (BJM (M) , JDIM, JWRAP) 

TM(M)=T 

RR  (M)  =G3NTRP  (R,  IDIM,  JDIM,  ITMDIM,  BIM  (M)  ,  BJM  (M)  ,  BBT) 

PP (M)-G3TRPA(P, IDIM, JDIM, ITMDIM, BIM (M) , BJM (M) ,BBT) 
WM  (M)  =G3NTRP  (VM,  IDIM,  JDIM,  ITMDIM,  BIM  (M)  ,  BJM  (M)  ,  BBT) 
RPPM«G3NTRP (RPP, ITMDIM,  1 , 1 ,  BBT,  1 .,  1 . ) 


ENRG=ABS  (ALAMdE)  )  *VVM(M) 

FZERO-G3NTRP (SCTFRC, lEDIM, JDIM, ITMDIM, FLOAT (IE) , BBJ, BBT) 
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IF(ISP.EQ.l)  THEN 


CALCULATE  LOSS  RATE  FOR  ELECTRONS 


msml.for 

MSM28810 

CALCULATE  LOSS  RATE  THIS  TIME  STEP  MSM28820 

MSM28830 

IF(ISP.EQ.l)  THEN  MSM28840 

MSM28850 

CALCULATE  LOSS  RATE  FOR  ELECTRONS  MSM28860 

MSM28870 

FIRST,  CALCULATE  STRONG  PITCH  ANGLE  SCATTERING  RATE  MSM28880 

RATEF= (4 . 45E-17) *SQRT (ABS (AALAM) /XMASS (IK) ) *G3NTRP (VMLOSS,  MSM28890 
2  IDIM, JDIM, ITMDIM,BBI,BBJ,BBT)  MSM28900 

STRONG (M) =FZERO*RATEF  MSM28910 

MSM28920 

NEXT,  CALCULATE  WEAK  LOSS  RATE  MSM28930 

WEAK(M)=WKRATE(RR{M) ,RPPM,PP (M) ,ENRG)  MSM28940 

MSM28950 

MSM28960 

ELSE  MSM28970 

MSM28980 

CALCULATE  LOSS  RATE  FOR  IONS  MSM28990 

STRONG  IS  SET  TO  ZERO  FOR  IONS  MSM29000 

WEAK  IS  USED  AS  AN  ALIAS  FOR  CHARGE  EXCHANGE  LOSS  RATE  MSM29010 


STRONG (M) =0 , 


END  IF 


CORRECT  J  MODULUS  OF  BBJ 


SSN  IS  SUNSPOT  NUMBER  MSM29020 

ISP  IS  SPECIES  NUMBER  <2  FOR  H+,  3  FOR  0+)  MSM29030 

MSM29040 

WEAK (M) =CEXRAT (ISP, ENRG, RR(M) , SSN, DKTIME, IRDK, INRGDK,  MSM29050 

ISOLDK, lONDK)  MSM29060 

MSM29070 

MSM29080 

MSM29090 

STRONG (M)=0,  MSM29100 

MSM29110 

END  IF  MSM29120 

MSM29130 

MSM29140 

MSM29150 

MSM29160 

:t  j  MODULUS  OF  BBJ  MSM29170 

MSM29180 

CALL  MODFIX(BBJ, JDIM, JWRAP)  MSM29190 

MSM29200 

IF  PARTICLE  HAS  PASSED  EITHER  TIME  OR  SPATIAL  BOUNDARY  MSM29210 

50,  EXIT  TIME  LOOP  MSM29220 

MSM29230 

MSM29240 

MSM29250 

IEXIT=0  MSM29260 

MSM29270 

IE  BOUNDARY  IS  CROSSED,  SET  IEXIT=1  AND  INTERPOLATE  MSM29280 

riND  ETABEG  AT  LOCATION  (BBI,BBJ)  MSM29290 

MSM29300 

4TINUE  MSM29310 

CALL  TCHK(T,TSTOP,DTNOM,BBI,BBJ,IEUSE, ETABEG, IDIM, JDIM,  MSM29320 

lEDIM, ETANIL,IEXIT)  MSM29330 

MSM29340 

IF(IEXIT.EQ.O)  THEN  MSM29350 

CHECK  TO  SEE  IF  SPATIAL  BNDY  IS  CROSSED  MSM29360 

MSM29370 

CALL  BNDCHK{T, IEUSE,BBI,BBJ,BIOLD,BJOLD,TIMTAG,ETABND,  MSM29380 

BNDMAX, BNDLOC, JDIM, lEDIM, ITMDIM, ITMMAX, JWRAP , ETANIL, lEXIT) MSM29390 

MSM29400 

END  IF  MSM29410 

MSM29420 

MSM29430 

IF(IEXIT.EQ.O)  THEN  MSM29440 


CALL  MODFIX(BBJ, JDIM, JWRAP) 

CHECK  IF  PARTICLE  HAS  PASSED  EITHER  TIME  OR  SPATIAL  BOUNDARY 
IF  SO,  EXIT  TIME  LOOP 


IEXIT=0 

IF  TIME  BOUNDARY  IS  CROSSED,  SET  IEXIT=1  AND  INTERPOLATE 
TO  FIND  ETABEG  AT  LOCATION  (BBI,BBJ) 

25  CONTINUE 

CALL  TCHK (T, TSTOP, DTNOM, BBI , BBJ, lEUSE,  ETABEG,  IDIM,  JDIM, 

1  lEDIM, ETANIL,  lEXIT) 

IF(IEXIT.EQ.O)  THEN 

CHECK  TO  SEE  IF  SPATIAL  BNDY  IS  CROSSED 


msml.for 


GO  TO  30 


FOR  NEXT  TIME  STEP 


ELSE 


C 

C 

C 

C 

C 


C 

C 


CALCULATE  ETA (I, J, IE) 


DO  300  N=M,2,-1 

CALCULATE  EQUILIBRIUM  ETA  AT  PT  (N-1) 

BT=TNORML(TM(N-l) , TIMTAG, ITMMAX) 

BIT=BIM{N-1) 

BJT=B JM (N-1 ) 

BIE=FLOAT(IE) 

ENRG=ABS  (ALAM(IE)  )  *WM(N-1) 

FKPEQ=- (KPDIM+1) 

FLXEQK=FLXVAL (ISP, FKPEQ, RR (N-1) , PP (N-1) , ENRG, IRDIM, 

2  NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXMAT, FLXR, 

3  FLXNRG,FLXKP) 

IF(ISP.EQ.l)  THEN 

ETAEQK=FLXEQK*ALMDEL (IE) /7 . 392E-16/ 

2  SORT  (ABS  (ALAM(IE)  )  ) /WM(N-l) 


C 

C 

C 

C 

C 


ELSE 

IF(ISP.EQ.2)  AWT=1. 

IF(ISP.EQ.3)  AWT=16. 

ETAEQK= (FLXEQK*ALMDEL (IE) *SQRT (AWT) ) / (1 . 731E-17* 
SQRT  (ABS  (ALAM(IE)  )  )  )  /WM(N-l) 

END  IF 


IF(ISP.EQ.l)  THEN 

CALCULATE  THRESHOLD  ETA 

SET  UP  INTERPOLATION  PARAMETERS  FOR  THRMAT  ARRAY 
BKP-FKP+1 . 

IF(BKP.GT,7.)  BKP=7. 

BNRG-4 . *ALOG10 (ENRG) -3. 


RLOG-ALOGIO (RR(N-l) ) 

IF (RLOG.GE. FLXR (IRDIM) )  THEN 
BR=IRDIM 

THRLOG=G3NTRP (THRMAT, IRDIM, NRGDIM, KPDIM, BR, BNRG, 
BKP)+ALOG10(13./RR(N-1) ) 

ELSE 


C 

C 

C 

C 

C 


18 

19 


DO  18  IR=1,IRDIM-1 

IF(RLOG.LE.FLXR(IR+l) )  THEN 

BR=FLOAT(IR)+(RLOG-FLXR(IR) ) / (FLXR(IR+1)- 

FLXR(IR)  ) 

GO  TO  19 
END  IF 
CONTINUE 

CONTINUE 

THRLOG=G3NTRP (THRMAT, IRDIM, NRGDIM, KPDIM, BR, BNRG, 
BKP) 

END  IF 

THRSHJ=1 0 . *  *THRLOG 
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msml.for 


ETATHR=THRSHJ*ALMDEL (IE) H . 392E-16/ 

SQRT  (ABS  (ALAM  (IE)  )  )  /WM  (N-1 ) 


END  IF 


CALCULATE  RHS  OF  D (ETA) /DT  EQN 

WKMID=.5* {WEAK(N)+WEAK{N-1) ) 

STRMID=.5* (STRONG (N)+STRONG (N-1) ) 
DETDTW=AMAX1 (0 . , (ETANIL-ETAEQK) ) *WKMID 


DETDTS=AMAX1 (0 . , (ETANIL-ETATHR) ) *STPMID 


IF (DETDTW.EQ. 0 . .AND.DETDTS.EQ. 0 . )  THEN 
ETANIL=ETANIL 
RATETA=0 . 

GO  TO  300 
END  IF 

IF (DETDTW.GT.DETDTS)  THEN 
RATE=WKMID 
ETAM=ETAEQK 
RATETA=DETDTW 
ELSE 

RATE=STRMID 
ETAM=ETATHR 
RATETA=DETDTS 
END  IF 

IF (RATE. GT. 10.)  THEN 

WRITE ( 6, * )  ' I , J, IE, WKMID, STRMID' , I , J, IE, WKMID, STRMID 
WRITE (6,795)  DETDTW,DETDTS,ETANIL 

795  format (IX, 'DETDTW=' , 1PE12. 3,2X, ' DETDTS=' , E12 . 3, 2X, ' ETA (N) =' , E12 . 

WRITE(6,799)  N, ETAM,ETANIL,TM (N-1 ) ,TM(N) , RATE 
799  FORMAT (IX, 'N=' , 16, 2X, 'ETAM=' , 1PE12 . 3, 2X, ' ETANIL=' ,E12.3,2X, 

2  'TM(N-1)=' ,F10.2,2X, 'TM(N)=' ,F10.2,2X, 'RATE=' ,E12.3) 

WRITE (6,*)  'STOPPING  IN  PPTM' 

STOP 
END  IF 

ETAOLD=ETANIL 

ETANIL=ETAM+ (ETAOLD-ETAM) *EXP (- (TM(N-l) -TM(N) ) *RATE) 


300  CONTINUE 


ETA(I, J, IE)=ETANIL 


BI«I 

BJ-J 

BT-TNORML (TSTART, TIMTAG, ITMMAX) 
VMVAL=G3NTRP (VM, IDIM, JDIM, ITMDIM, BI , BJ, BT) 
ENRG-ABS (ALAM (IE) ) *VMVAL 
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MSM30450 

3)MSM30460 

MSM30470 

MSM30480 
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MSM30500 

MSM30510 

MSM30520 

MSM30530 

MSM30540 
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MSM30570 
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MSM30610 
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MSM30640 

MSM30650 

MSM30660 
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MSM30680 
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MSM30720 


on  o  o  nooooo  ooo  oooo  oo 


msml.for 

c 

c 

c 

C  COMPUTE  PARTICLE  FLUX  ASSOCIATED  WITH  ETA(I,J, IE).  IF  COMPUTED 
C  FLUX  IS  GREATER  THAN  UPPER  LIMIT  REFERENCE  FLUX,  THEN  REDUCE  ETA 
C  TO  BE  CONSISTENT  WITH  REFERENCE  FLUX.  REF:  SECTION  2.5.6  OF  THE 
C  FINAL  REPORT  FOR  CONTRACT  #F19628-87-K-0001 . 

C 

IF(ISP.EQ.l)  THEN 

FLUX=7.392E-16*SQRT{ABS{ALAM(IE) ) ) *VMVAL* 

2  ETA(I, J, IE) /ALMDEL(IE) 

ELSE 

IF(ISP.EQ.2)  THEN 
AWT=1 . 

ELSE 

AWT=16. 

END  IF 
C 

FLUX=1 . 731E-17*SQRT (ABS (ALAM(IE) ) ) *VMVAL* 

2  ETA (I ,  J, IE) / (ALMDEL (IE) *SQRT (AWT) ) 

C 

END  IF 


892  FORMAT (IX, 'VMVAL=' ,F8.3,2X, ' ALMDEL=' , 1PE12 . 3, 2X, ' FLUX=' , E12 . 3, 2X, 
2  'FLXREF=' ,E12.3) 

IF(FLUX.GT.FLXREF(I, J,IE) )  THEN 

WRITE (6,*)  'COMPUTED  FLUX  EXCEEDS  REFERENCE  FLUX', 

2  J=',J,'  1E=',IE, 

3  '  FLUX-' ,  FLUX,  '  REF  FLID(=' .  ^LXREF  (I ,  J,  IE) 
CORRECT  ETA  TO  REFERENCE  FLUX  VALUE 

ETAS-ETA(I, J,IE) 

ETA (I, J, IE) =ETA (I, J, IE) *FLXREF (I, J, IE) /FLUX 

DEBUG  PRINTOUT 

WRITE (6,*)  'COMPUTED  ETA=  ',ETAS, 

2  '  CORRECTED  ETA=' , ETA (I, J, IE) 

END  IF 

END  IF 


END  IF 

23  CONTINUE 
IF(ISP.EQ.l)  THEN 

CALCULATE  PRECIPITATING  ENERGY  FLUX  AND  FLUX  SUMS 
BBI=I 
BBJ=J 

BIRM-G3NTRP (BIR, IDIM, JDIM, 1 , BBl , BBJ, 1 . ) 
DETDTW-AMAXl (0. , (ETA(I, J, IE)-ETAEQK) ) *WEAK(1) 
DETDTS-AMAXl (0. , (ETA(I, J, IE) -ETATHR) ) *STRONG(l) 
RATETA-AMAXl (DETDTW, DETDTS) 

FLUXN=RATETA*BIRM/2 . E13 

EFLUX  (I,  J,  IE)  =  .  8E-25*RATETA*BIRM*ABS  (AALAM)  *WM(1) 
FLXSUMd,  J,  IK)=FLXSUM(I,  J,  IK)+EFLUX(I,  J,  IE) 

DENSUM (I , J, IK) -DENSUM (I , J, IK) +FLUXN 
C 

END  IF 

24  CONTINUE 

ETA ( I , 1 , IE) =ETA ( I , JDIM- JWRAP+1 , IE) 


MSM30730 

MSM30740 

MSM30750 

MSM30760 

MSM30770 

MSM30780 

MSM30790 

MSM30800 

MSM30810 

MSM30820 

MSM30830 

l^M30840 

MSM30850 

MSM30860 

MSM30870 

MSM30880 

MSM30890 

MSM30900 

MSM30910 

MSM30920 

MSM30930 

MSM30940 

MSM30950 

MSM30960 

MSM30970 

MSM30980 

MSM30990 

MSM31000 

MSM31010 

MSM31020 

MSM31030 

MSM31040 

MSM31050 

MSM31060 

MSM31070 

MSM31080 

MSM31090 

MSM31100 

MSM31110 

MSM31120 

MSM31130 

MSM31140 

MSM31150 

MSM31160 

MSM31170 

MSM31180 

MSM31190 

MSM31200 

MSM31210 

MSM31220 

MSM31230 

MSM31240 

MSM31250 

MSM31260 

MSM31270 

MSM31280 

MSM31290 

MSM31300 

MSM31310 

MSM31320 

MSM31330 

MSM31340 

MSM31350 

MSM31360 


ooo  o  oooooooo  ooooooon  o  on  nnnnooonnnn 


msml.for 

ETA(I,2,IE)=ETA(I, JDIM-JWRAP+2,IE) 

ETA(I, JDIM, IE)=ETA(I, JWRAP,IE) 

IF(ISP.EQ.l)  THEN 

EFLUX (I, 1, IE) =EFLUX (I, JDIM-JWRAP+1, IE) 
EFLUX ( I , 2 , IE) =EFLUX ( I , JDIM- JWRAP+2 , IE) 
EFLUX {I, JDIM, IE) =EFLUX (I, JWRAP, IE) 
FLXSUMd,  1,  IK)  =FLXSUM (I,  JDIM-JWRAP+1,  IK) 
FLXSUM (I, 2, IK) =FLXSUM (I, JDIM- JWRAP+2, IK) 
FLXSUM (I , JDIM, IK) =FLXSUM (I, JWRAP, IK) 
DENSUM ( I , 1 , IK) =DENSUM {I , JDIM-JWRAP+1 , IK) 
DENSUM ( I , 2 , IK) =DENSUM ( I , JDIM- JWRAP+2 , IK) 
DENSUM ( I ,  JDIM, IK) =DENSUM ( I , JWRAP , IK) 

END  IF 


PRINT  THE  TIME  SPENT  PROCESSING  LATITUDE  I 
CALL  DTIME(ITRCEN) 

WRITE  (LUERR,*)  'THE  TIME  SPENT  TRACING  PARTICLE  ',IE, 
$  'AT  LATITUDE  INDEX  WAS  ', 

$  ABS(ITRCEN-ITRCST)  ,'  SECONDS.' 


20  CONTINUE 


WRITE (18,*)  'IE=',IE,'T=',TSTART 
WRITE (6,*)  ' IE-' , IE, 'T-' ,TSTART 

IBM-IDIM 

DO  6  JJJ-1,JDIM 

IF(INT(BNDLOC(JJJ,LL) ) .LT.IBM)  IBM=BNDLOC ( JJJ, LL) 
6  CONTINUE 


PRINT  TOTAL  COMP.  TIME  FOR  THIS  K  VALUE 
CALL  DTIME(ITKEND) 

WRITE  (LUERR,*)  'THE  TOTAL  TIME  SPENT  TRACING  K  =  ',  IE, 
$  '  WAS  ',  ABS (ITKEND-ITKST)  ,'  SECONDS.' 

10  CONTINUE 


CALCULATE  PRECIPITATING  FLUXES  AND  ENERGIES 
INITIALIZATION  OF  PRECIPITATION  ARRAYS 


DO  200  I-IBEG,ISTOP 
DO  200  J=JBEG,JSTOP 

IF(DENSUM(I, J,l) .GT.O.)  THEN 

EAVG ( I , J, 1 ) =FLXSUM ( I , J, 1 ) /DENSUM ( I , J, 1 ) 
CONVERT  EAVG  TO  EV  FROM  ERGS 

EAVGd,  J,  1)=EAVG(I,  J,  1)  *6.242E11 
ELSE 

EAVGd,  J,  D'O. 

END  IF 


1  EAVG(I,J,1) 

200  CONTINUE 


MSM31370 

MSM31380 

MSM31390 

MSM31400 

MSM31410 

MSM31420 

MSM31430 

MSM31440 

MSM31450 

MSM31460 

MSM31470 

MSM31480 

MSM31490 

MSM31500 

MSM31510 

MSM31520 

MSM31530 

MSM31540 

MSM31550 

MSM31560 

MSM31570 

MSM31580 

MSM31590 

MSM31600 

MSM31610 

MSM31620 

MSM31630 

MSM31640 

MSM31650 

MSM31660 

MSM31670 

MSM31680 

MSM31690 

MSM31700 

MSM31710 

MSM31720 

MSM31730 

MSM31740 

MSM31750 

MSM31760 

MSM31770 

MSM31780 

MSM31790 

MSM31800 

MSM31810 

MSM31820 

MSM31830 

MSM31840 

MSM31850 

MSM31860 

MSM31870 

MSM31880 

MSM31890 

MSM31900 

MSM31910 

MSM31920 

MSM31930 

MSM31940 

MSM31950 

MSM31960 

MSM31970 

MSM31980 

MSM31990 

MSM32000 


noon 


msml.for 


c 

c 

c 

c 

c 

c 

c 

c 


RETURN 

END 

SUBROUTINE  BNDCHK (T, IE, BBI,  BBJ,  BIOLD,  BBJOLD, TIMTAG, ETABND, BNDMAX, 
1  BNDLOC, JDIM, lEDIM, ITMDIM, ITMMAX, JWRAP, ETANIL, lEXIT) 


C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


VERSION  1.00 


DATE:  01.11.88 


PURPOSE:  SUBROUTINE  TO  DETERMINE  WHETHER  PARTICLE  HAS  CROSSED 

BNDY  OF  CALCULATION.  IF  SO,  lEXIT  IS  SET  EQUAL  TO  2  AND 
ETANIL=ETA  VALUE  AT  BOUNDARY  CROSSING  PT  IS  CALCULATED. 


INPUT : 

T 

IE 

BBI 

BBJ 

BIOLD 

BBJOLD 

TIMTAG 

ETABND 

BNDMAX 

BNDLOC 

JDIM 

lEDIM 

ITMDIM 

ITMMAX 

JWRAP 

OUTPUT : 

ETANIL 

lEXIT 


TIME 

PARTICLE  SPECIES  (IE.,  ENERGY  CHANNEL) 

I  LOCATION  AT  END  OF  TIME  STEP 

J  LOCATION  AT  END  OF  TIME  STEP 

I  LOCATION  AT  BEGINNING  OF  TIME  STEP 

J  LOCATION  AT  BEGINNING  OF  TIME  STEP 

VECTOR  GIVING  EVENT  TIMES  FOR  WHICH  DATA  ARRAYS  ARE 

GIVEN 

ETA  DISTRIBUTION  ON  BOUNDARY  (DEPENDS  ON  TIME) 
VECTOR  GIVING  MAX  I  VALUE  OF  BNDY  LOCATION  AT  EACH 
J  VALUE 

ARRAY  GIVING  BNDY  LOCATION  AS  FUNCTION  OF  TIME 

NUMBER  OF  LONGITUDE  GRID  POINTS  (INCL  WRAPAROUND) 

NUMBER  OF  ENERGY  SPECIES 

MAX  NUMBER  OF  TEMPORAL  GRID  POINTS 

NUMBER  OF  TEMPORAL  PTS  FILLED 

J  WRAP-AROUND 


IF  BNDY  IS  CROSSED,  ETANIL  IS  THE  VALUE  OF  ETA 
AT  THE  BNDY  CROSSING  PT 
IF  BNDY  IS  CROSSED,  IEXIT=  2 


PROGRAMMER:  R.  W.  SPIRO 


DIMENSION  TIMTAG (ITMDIM) , BNDMAX (JDIM) , BNDLOC (JDIM, ITMDIM) 
DIMENSION  ETABND(JDIM,IEDIM, ITMDIM) 

COMMON / TMP 6 / I I I , J J J 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 


IF  SPATIAL  BOUNDARY  IS  CROSSED,  SET  IEXIT=2,  CALCULATE  CROSSING 
POINT,  AND  VALUE  OF  ETA  AT  CROSSING  POINT 

INITIAL  CHECK  -  EVALUATE  BI  AT  MAXIMUM  BOUNDARY  VALUES  AT  BJ=BBJ 

JJ-BBJ 

BIVAL= (BBJ-REAL ( JJ) ) *BNDMAX ( JJ+1) + (REAL ( JJ+1) -BBJ) *BNDMAX ( JJ) 
IF(BBI.LE.BIVAL)  THEN 


MSM32010 

MSM32020 

MSM32030 

MSM32040 

MSM32050 

MSM32060 

MSM32070 

MSM32080 

MSM32090 

MSM32100 

MSM32110 

MSM32120 

MSM32130 

MSM32140 

MSM32150 

MSM32160 

MSM32170 

MSM32180 

MSM32190 

MSM32200 

MSM32210 

MSM32220 

MSM32230 

MSM32240 

MSM32250 

MSM32260 

MSM32270 

MSM32280 

MSM32290 

MSM32300 

MSM32310 

MSM32320 

MSM32330 

MSM32340 

MSM32350 

MSM32360 

MSM32370 

MSM32380 

MSM32390 

MSM32400 

MSM32410 

MSM32420 

MSM32430 

MSM32440 

MSM32450 

MSM32460 

MSM32470 

MSM32480 

MSM32490 

MSM32500 

MSM32510 

MSM32520 

MSM32530 

MSM32540 

MSM32550 

MSM32560 

MSM32570 

MSM32580 

MSM32590 

MSM32600 

MSM32610 

MSM32620 

MSM32630 

MSM32640 


oooo  n  ooo  oooo  o  oooooooo  oooo 


f  jv  y<  •'•rf  ' 


msml.for 

WE  NEED  TO  PERFORM  TIME  INTERPOLATION 
BOUNDARY  LOCATION  AND  CHECK  AGAINST 
LOCATION  (BBI,BBJ) 


BBT=TNORML (T, TIMTAG, ITMMAX) 

ITM-BBT 

BNDJ= (1 . -BBT+REAL (ITM) ) *BNDLOC ( JJ, ITM) 

+ (BBT-REAL (ITM) ) *BNDLOC (JJ, ITM+1) 

BNDJP= (1 . -BBT+REAL (ITM) ) *BNDLOC ( JJ+1, ITM) 

+ (BBT-REAL (ITM) ) *BNDLOC (JJ+1, ITM+1) 

BIVAL- (BBJ-REAL ( JJ) ) *BNDJP+ (REAL (JJ+1) -BBJ) *BNDJ 

IF(BBI.LE.BIVAL)  THEN 


PARTICLE  HAS  CROSSED  SPATIAL  BOUNDARY 

SET  IEXIT=2  AND  CALCULATE  CROSSING  POINT 

I EXIT-2 

BJOLD-BBJOLD 

NEED  TO  GET  BBJ  AND  BJOLD  IN  SAME  MODULUS 

IF(BBJOLD-BBJ.GT.REAL(JDIM-JWRAP) /2. )  THEN 
BJOLD-BBJOLD-REAL ( JDIM- JWRAP) 

END  IF 


IF (BBJ-BBJOLD . GT . REAL (JDIM- JWRAP) /2 . ) 

3J0LD-BJ0LD+REAL ( JDIM-JWRAP) 

END  IF 


THEN 


LINEl  IS  LINE  FROM  OLD  LOCATION  (BIOLD, BJOLD)  TO  NEW  LOCATION 
(BBI,BBJ).  DESCRIBE  LINE  AS  BI=DIDJ*BJ+BICON 

IF(ABS (BBJ-BJOLD) .LE.l.E-6)  THEN 
BJCRSS-BBJ 
ELSE 

DIDJl- (BBI -BIOLD) / (BBJ-BJOLD) 

BICONl- ( BIOLD ‘BBJ-BBI* BJOLD) / (BBJ-BJOLD) 

JJBEG-MIN (BJOLD,  BBJ) 

JJEND-MAX (BJOLD,  BBJ) 

CHECK  ALL  POSSIBLE  CROSSING  SEGMENTS 

DO  40  JJ-JJBEG, JJEND 

BNDJJ- (1 . -BBT+REAL (ITM) ) *BNDLOC ( JJ, ITM) 

1  + (BBT-REAL (ITM) )*BNDLOC(JJ, ITM+1) 

BNDJJP- (1 . -BBT+REAL (ITM) ) *BNDLOC (JJ+1, ITM) 

1  + ( BBT -REAL (ITM))*  BNDLOC ( J J+ 1 , 1 TM+ 1 ) 

DIDJ2- (BNDJJP-BNDJJ) 

BICON2-BNDJJ*REAL ( JJ+1 ) -BNDJJP*REAL ( JJ) 

IF (ABS(DIDJ2-DIDJ1) .LE.l.E-6)  GO  TO  40 

BJCRSS- (BICON1-BICON2) / {DIDJ2-DIDJ1 ) 

CHECK  IF  CROSSING  IS  BETWEEN  JJ  AND  JJ+1 

1F(BJCRSS.GE.REAL(JJ) . AND . BJCRSS . LE . REAL (JJ+1 ) ) 
BOUNCE  OUT  OF  DO  40  LOOP 
GO  TO  50 
END  IF 

IF(JJBEG.EQ. JJEND)  GO  TO  50 
40  CONTINUE 


OF  MSM32650 
MSM32660 
MSM32670 
MSM32680 
MSM32690 
MSM32700 
MSM32710 
MSM32720 
MSM32730 
MSM32740 
MSM32750 
MSM32760 
MSM32770 
MSM32780 
MSM32790 
MSM32800 
MSM32810 
MSM32820 
MSM32830 
MSM32840 
MSM32850 
MSM32860 
MSM32870 
MSM32880 
MSM32890 
MSM32900 
MSM32910 
MSM32920 
MSM32930 
MSM32940 
MSM32950 
MSM32960 
MSM32970 
MSM32980 
MSM32990 
MSM33000 
MSM33010 
MSM33020 
MSM33030 
MSM33040 
MSM33050 
MSM33060 
MSM33070 
MSM33080 
MSM33090 
MSM33100 
MSM33110 
MSM33120 
MSM33130 
MSM33140 
MSM33150 
MSM33160 
MSM33170 
MSM33180 
MSM33190 
MSM33200 
MSM33210 
THENMSM33220 
MSM33230 
MSM33240 
MSM33250 
MSM33260 
MSM33270 
MSM33280 


oo  o  ooo  ooo  ooooo 


msml.for 


WRITE (6,  *) 
WRITE (6,*) 
WRITE (6,*) 
BJCRSS=BBJ 
WRITE (6,*) 


'FAILED  TO  FIND  BNDY  CROSSING  IN  SUBROUTINE  PPTM' 

' T, IE, BBI , BBJ, BIOLD, BBJOLD' , T, IE, BBI , BBJ, BIOLD, BBJOLD 
'BJCRSS' ,BJCRSS 

'USING  BBJ  AS  CROSSING  POINT=' , BBJ 


DEBUG  -  FAILED  TO  FIND  BOUNDARY  CROSSING  MSM33290 

MSM33300 

6,*)  'FAILED  TO  FIND  BNDY  CROSSING  IN  SUBROUTINE  PPTM'  MSM33310 

6, * )  ' T, IE, BBI , BBJ, BIOLD, BBJOLD' , T, IE, BBI , BBJ, BIOLD, BBJOLD  MSM33320 
6,*)  'BJCRSS' , BJCRSS  MSM33330 

=BBJ  MSM33340 

6,*)  'USING  BBJ  AS  CROSSING  POINT=' , BBJ  MSM33350 

MSM33360 
MSM33370 

CONTINUE  MSM33380 

MSM33390 

POINT  IS  BJCRSS.  COMPUTE  ETANIL=  ETA  AT  BNDY  CROSSING  MSM33400 

MSM33410 

JJ-BJCRSS  MSM33420 

ETAJ= (1 . -BBT+REAL (ITM) ) *ETABND ( JJ, IE, ITM)  MSM33430 

+ (BBT-REAL (ITM) ) *ETABND (JJ, IE, ITM+1)  MSM33440 

ETAJP= (1 . -BBT+REAL (ITM) ) *ETABND ( JJ+1, IE, ITM)  MSM33450 

+ (BBT-REAL (ITM) ) *ETABND ( JJ+1 , IE, ITM+1)  MSM33460 

MSM33470 

ETANIL= (1 . -BJCRSS+REAL ( JJ) ) *ETAJ+ (BJCRSS-REAL ( JJ) ) *ETAJP  MSM33480 
IF(IE.EQ.1.0R.IE.EQ.17)  WRITE (6, 900 ) III , JJJ, ITM, IE,  MSM33490 

BBT, BBI, BBJ, JJ, ETAJ, ETAJP, ETANIL  MSM33500 

FORMATdH  , 'III,  JJJ, ITM,IE, BBT, BBI, BBJ,  JJ, ETAJ, ETAJP,  MSM33510 
ETANIL' /4I4,3F15.5,I4, 3E15.5)  MSM33520 

END  IF  MSM33530 


50  CONTINUE 

CROSSING  POINT  IS  BJCRSS.  COMPUTE  ETANIL=  ETA  AT  BNDY  CROSSING 
JJ-BJCRSS 

ETAJ= (1 . -BBT+REAL (ITM) ) *ETABND ( JJ, IE, ITM) 

1  + (BBT-REAL (ITM) ) *ETABND (JJ, IE, ITM+1) 

ETAJP= (1 . -BBT+REAL (ITM) ) *ETABND (JJ+1, IE, ITM) 

1  + (BBT-REAL (ITM) ) *ETABND ( JJ+1 , IE, ITM+1) 


END  IF 

END  IF 

RETURN 

END 

FUNCTION  DVEFDI (I , J, BT, AALAM, V, VM, IDIM, JDIM, ITMDIM) 


VERSION  1.00 


DATE:  12.16,87 
02.02.89 


PURPOSE: 


FUNCTION  SUBPROGRAM  TO  COMPUTE  THE  I  DERIVATIVE  OF  THE 
EFFECTIVE  POTENTIAL  AT  GRID  POINT  (I,J)  AT  NORMALIZED 
TIME  BT. 


INPUT : 

I 

J 

BT 

AALAM 

V 

VM 

IDIM 

JDIM 

ITMDIM 

OUTPUT : 
DVEFDI 

PROGRAMMER: 


I  COORDINATE  OF  THE  GRID  POINT 
J  COORDINATE  OF  THE  GRID  POINT 
NORMALIZED  TIME 

ENERGY  INVARIANT  (EV  (RE/NT) **2/3) 
ELECTRIC  POTENTIAL  ARRAY  (VOLTS) 


MSM33490 

MSM33500 

MSM33510 

MSM33520 

MSM33530 

MSM33540 

MSM33550 

MSM33560 

MSM33570 

MSM33580 

MSM33590 

MSM33600 

MSM33610 

MSM33620 

MSM33630 

MSM33640 

MSM33650 

MSM33660 

MSM33670 

MSM33680 

MSM33690 

MSM33700 

MSM33710 

MSM33720 

MSM33730 

MSM33740 

MSM33750 


(FLUX  TUBE  VOLUME) **-2/3  ARRAY  (RE/NT) **-2/3MSM33760 


I  DIMENSION  OF  V  AND  VM 
J  DIMENSION  OF  V  AND  VM 
TIME  DIMENSION  OF  V  AND  VM 


D (V+AALAM*VM) /DI  AT  (I,J,BT) 


R.  W.  SPIRO 


COMMON  /GRID/DLAM,DPSI,RI, JWRAP 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 


MSM33770 

MSM33780 

MSM33790 

MSM33800 

MSM33810 

MSM33820 

MSM33830 

MSM33840 

MSM33850 

MSM33860 

MSM33870 

MSM33880 

MSM33890 

MSM33900 

MSM33910 

MSM33920 


msml.for 

LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
DIMENSION  V(IDIM, JDIM, ITMDIM) ,VM(IDIM, JDIM, ITMDIM) 

ITT-BT 

FT»REAL(ITT) 

IMIN-1 
IMAX-IDIM 
ir(J.LT.2)  THEN 

JX“J+ (JDIM-JWRAP) 

ELSE  IF{J.GT. JDIM-1)  THEN 
JX»J- (JDIM-JWRAP) 

ELSE 
JX=J 
END  IF 

COMPUTE  DVEFDI 

IF(I.EQ.IMIN)  THEN 

DVEFDI- (1 . -BT+FT) *(-1.5* (V (IMIN, JX, ITT) +AALAM*VM (IMIN, JX, ITT) 

1  +2.* (V(IMIN+1, JX,ITT)+AALAM*VM{IMIN+1, JX,ITT) ) 

2  -.5* (V(IMIN+2, JX,ITT)+AALAM*VM(IMIN+2, JX,ITT) ) ) 

3  + (BT-FT) *(-1.5* (V (IMIN, JX, ITT+1 ) +AALAM*VM (IMIN, JX, ITT+1 

4  +2.* (V(IMIN+1,JX,ITT+1)+AALAM*VM(IMIN+1,JX, ITT+1) ) 

5  -.5* (V(IMIN+2, JX, ITT+1 )+AALAM*VM(IMIN+2,JX, ITT+1 ) ) ) 
ELSE  IF(I.EQ.IMAX)  THEN 

DVEFDI- (1 . -BT+FT) *(-1.5* (V (IMAX, JX, ITT) +AALAM*VM (IMAX, JX, ITT) 

1  +2.* (V(IMAX-1, JX,ITT)+AALAM*VM(IMAX-1, JX,ITT) ) 

2  -.5*(V(IMAX-2,JX,ITT)+AALAM*VM(IMAX-2,JX,ITT) ) ) 

3  + (BT-FT) * (-1 . 5* (V (IMAX, JX, ITT+1) +AALAM*VM( IMAX, JX, ITT+1 

4  +2.* (V(IMAX-1, JX,ITT+1)+AALAM*VM(IMAX-1, JX,ITT+1) ) 

5  -.5* (V(IMAX-2,JX,ITT+1)+AALAM*VM(IMAX-2,JX, ITT+1) ) ) 
ELSE  IF  (I.GT.IMIN.AND.I.LT.IMAX)  THEN 

DVEFDI- ( (1 . -BT+FT) * (V (I+l, JX, ITT) +AALAM*VM (I+l, JX, ITT) 

1  -V(I-1, JX, ITT) -AALAM*VM(I-1, JX,ITT) )+ 

2  (BT-FT) * (V(I+1, JX, ITT+1 )+AALAM*VM (I+l, JX, ITT+1) 

3  -V(I-1, JX, ITT+1) -AALAM*VM(I-1,JX, ITT+1) ) ) /2. 


ELSE 

WRITE 
WRITE 
WRITE 
END  IF 


'LUERR,  *)  'Error  in  Function  DVEFDI,  I  out  of  range.' 
(LUERR, *)  'I  =  ',!,'  JX  =  ',JX, '  ITT  =  '  ,  ITT 
(LUERR,*)  '  ' 


RETURN 

END 

FUNCTION  DVEFD J ( I , J, BT, AALAM, V, VM, IDIM, JDIM, ITMDIM) 


VERSION  1.00 
I.OIA 


DATE:  12.16.87 
02.02.89 


PURPOSE:  FUNCTION  SUBPROGRAM  TO  COMPUTE  THE  J  DERIVATIVE  OF  THE 

EFFECTIVE  POTENTIAL  AT  GRID  POINT  (I,J)  AT  NORMALIZED 
TIME  BT. 


INPUT: 

I 

J 

BT 

AALAM 

V 

VM 

IDIM 

JDIM 

ITMDIM 

JWRAP 


I  COORDINATE  OF  THE  GRID  POINT 
J  COORDINATE  OF  THE  GRID  POINT 
NORMALIZED  TIME 

ENERGY  INVARIANT  (EV  (RE/NT) **2/3) 

ELECTRIC  POTENTIAL  ARRAY  (VOLTS) 

(FLUX  TUBE  VOLUME) **-2/3  ARRAY  (RE/NT) **-2 
I  DIMENSION  OF  V  AND  VM 
J  DIMENSION  OF  V  AND  VM 
TIME  DIMENSION  OF  V  AND  VM 
J  WRAP  AROUND 


MSM33930 
MSM33940 
MSM33950 
MSM33960 
MSM33970 
MSM33980 
MSM33990 
MSM34000 
MSM34010 
MSM34020 
MSM34030 
MSM34040 
MSM34050 
MSM34060 
MSM34070 
MSM34080 
MSM34090 
MSM34100 
)  MSM34110 
MSM34120 
MSM34130 
)  )MSM34140 
MSM34150 
MSM34160 
MSM34170 
)  MSM34180 
MSM34190 
MSM34200 
)  )MSM34210 
MSM34220 
MSM34230 
MSM34240 
MSM34250 
MSM34260 
MSM34270 
MSM34280 
MSM34290 
MSM34300 
MSM34310 
MSM34320 
MSM34330 
MSM34340 
MSM34350 
MSM34360 
MSM34370 
MSM34380 
MSM34390 
MSM34400 
MSM34410 
MSM34420 
MSM34430 
MSM34440 
MSM34450 
MSM34460 
MSM34470 
MSM34480 
MSM34490 
MSM34500 
MSM34510 
/3MSM34520 
MSM34530 
MSM34540 
MSM34550 
MSM34560 


msml.for 


c 

C  OUTPUT: 

C  DVEFDI  D (V+AALAM*VM) /DI  AT  (I,J,BT) 

C 

C  PROGRAMMER:  R.  W.  SPIRO 
C 
C 
C 

COMMON  /GRID/DLAM,DPSI,RI, JWRAP 
C 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LU2MIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
DIMENSION  V(IDIM, JDIM, ITMDIM) , VM(IDIM, JDIM, ITMDIM) 

C 

ITT=BT 

FT-REAL(ITT) 

C 

C  PUT  J  IN  CORRECT  MODULUS  FOR  CALCULATION 
C 

IF(J.LT.2)  THEN 

JX«J+ (JDIM- JWRAP) 

ELSE  IF(J.GT. JDIM-1)  THEN 
JX-J- (JDIM- JWRAP) 

ELSE 
JX-J 
END  IF 
C 

C  COMPUTE  DVEFDJ 
C 

DVEFDJ- ( (i.-BT+FT) * (V (I , JX+1 , ITT) +AALAM*VM(I, JX+1, ITT) 

1  -V(I,  JX-1,ITT)-AALAM*VM(I, JX-1,ITT) )  + 

2  (BT-FT)* (V(I, JX+1,ITT+1)+AALAM*VM(I, JX+1,ITT+1) 

3  -V(I, JX-1, ITT+i: -AALAM*VM(I, JX-1, ITT+1) ) ) /2. 

C 

RETURN 

END 

FUNCTION  G3NTRP (A, IMAX, JMAX, KMAX, BI , BJ, BK) 

C 

C  VERSION  1.00  DATE:  01.11.88 

C  I.OIA  02.02.89 


C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PURPOSE:  FUNCTION  SUBPROGRAM  TO  PERFORM  A  GENERAL  3-D  LINEAR 

INTERPOLATION  OF  ARRAY  A(I,J,K)  AT  PT (BV ( 1 ) , BV (2 ) , BV ( 3) ) 


INPUT: 

A  3-D  ARRAY  TO  BE  INTERPOLATED 


IMAX 

I  DIMENSION  OF 

ARRAY 

A 

JMAX 

J  DIMENSION  OF 

ARRAY 

A 

KMAX 

K  DIMENSION  OF 

ARRAY 

A 

BI 

FLOATING  POINT 

VALUE 

TO 

INTERPOLATE 

IN 

I 

DIMENSION 

BJ 

FLOATING  POINT 

VALUE 

TO 

INTERPOLATE 

IN 

J 

DIMENSION 

BK 

FLOATING  POINT 

VALUE 

TO 

INTERPOLATE 

IN 

K 

DIMENSION 

OUTPUT: 

G3NTRP  INTERPOLATED  VALUES  OF  ARRAY  A 

INTERPOLATE  A 


MSM34570 

MSM34580 

MSM34590 

MSM34600 

MSM34610 

MSM34620 

MSM34630 

MSM34640 

MSM34650 

MSM34660 

MSM34670 

MSM34680 

MSM34690 

MSM34700 

MSM34710 

MSM34720 

MSM34730 

MSM34740 

MSM34750 

MSM34760 

MSM34770 

MSM34780 

MSM34790 

MSM34800 

MSM34810 

MSM34820 

MSM34830 

MSM34840 

MSM34850 

MSM34860 

MSM34870 

MSM34880 

MSM34890 

MSM34900 

MSM34910 

MSM34920 

MSM34930 

MSM34940 

MSM34950 

MSM34960 

MSM34970 

MSM34980 

MSM34990 

MSM35000 

MSM35010 

MSM35020 

MSM35030 

MSM35040 

MSM35050 

MSM35060 

MSM35070 

MSM35080 

MSM35090 

MSM35100 

MSM35110 

MSM35120 

MSM35130 

MSM35140 

MSM35150 

MSM35160 

MSM35170 

MSM35180 

MSM35190 

MSM35200 


oooo  onooonooon  no  n  no 


msml.for 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
DIMENSION  AdMAX,  JMAX,KMAX) 

DIMENSION  NDX(3) ,NDIM(3) ,BV(3) ,COEF(3,2) 


PREPARE  INDICES  FOR  INTERPOLATION 


NDIM(1)=IMAX 

NDIM(2)=JMAX 

NDIM(3)=KMAX 

BV(1)=BI 

BV(2)-BJ 

BV(3)=BK 

DO  10  L=l,3 

NDX(L)=BV(L) 

IF{NDX(L) .LT.l)  NDX(L)=1 

IF(NDX(L) .GT.NDIM(L) -1)  NDX (L) =NDIM (L) -1 

IF{NDX(L) .LE.O)  NDX(L)=1 

FNDX=REAL (NDX (L) ) 

COEF  (L,  1)  =1 .  -BV  (L)  +FNDX 
COEF (L, 2) =BV (L) -FNOX 
10  CONTINUE 


G3NTRP=0. 

KSTOP  =  MIN(KMAX,2) 

JSTOP  -  MIN (UMAX, 2) 

DO  20  1=1,2 
DO  20  J=l, JSTOP 
DO  20  K=l, KSTOP 
G3NTRP=G3NTRP+ 

1  COEF(l,I) *COEF(2, J) *COEF (3, K) *A (NDX (1 ) +1-1, NDX (2) +J-1, 

2  NDX(3)+K-1) 

20  CONTINUE 

RETURN 

END 

SUBROUTINE  MODFIX (BBJ, JDIM, JWRAP) 

VERSION  1.00  DATE:  01.15.88 

PURPOSE:  SUBROUTINE  TO  ADJUST  BBJ  TO  BE  BETWEEN  2  AND  JDIM-1 

INPUT: 

BBJ  VALUE  TO  BE  ADJUSTED 

JDIM  J  DIMENSION  OF  ARRAYS 

JWRAP  J  WRAP  AROUND 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX,  JEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD , LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
IF (BBJ. LT. REAL (2) )  BBJ=BBJ+REAL ( JDIM-JWRAP) 

IF (BBJ. GT. REAL (JDIM-1) )  BBJ=BBJ-REAL (JDIM- JWRAP ) 

RETURN 

END 

SUBROUTINE  MOVER (T, DTTRY, BIOLD, BJOLD, EPS, BBISCL, BBJSCL, DTUSED, 

1  DTNEXT,AALAM,V,VM,T1MTAG, ALPHA, BETA,  BIR, IDIM,  JDIM, ITMDIM, BBI , BBJ) 

VERSION  1.00  DATE:  01.15.88 

PURPOSE:  SUBROUTINE  TO  ADVANCE  ONE  PARTICLE  LOCATION  ONE  TIME 


MSM35210 

MSM35220 

MSM35230 

MSM35240 

MSM35250 

MSM35260 

MSM35270 

MSM35280 

MSM35290 

MSM35300 

MSM35310 

MSM35320 

MSM35330 

MSM35340 

MSM35350 

MSM35360 

MSM35370 

MSM35380 

MSM35390 

MSM35400 

MSM35410 

MSM35420 

MSM35430 

MSM35440 

MSM35450 

MSM35460 

MSM35470 

MSM35480 

MSM35490 

MSM35500 

MSM35510 

MSM35520 

MSM35530 

MSM35540 

MSM35550 

MSM35560 

MSM35570 

MSM35580 

MSM35590 

MSM35600 

MSM35610 

MSM35620 

MSM35630 

MSM35640 

MSM35650 

MSM35660 

MSM35670 

MSM35680 

MSM35690 

MSM35700 

MSM35710 

MSM35720 

MSM35730 

MSM35740 

MSM35750 

MSM35760 

MSM35770 

MSM35780 

MSM35790 

MSM35800 

MSM35810 

MSM35820 

MSM35830 

MSM35840 


on  ooo  o  ooooo  o  oooo  ooo  non  on 


msml.for 


TAKE  TWO  HALF  STEPS 


DT2=DT/2. 

CALL  RK4 (TSAV,DT2,BBISAV,BBJSAV,BBI0UT,BBJ0UT,AALAM,V,VM, 
1  TIMTAG, ALPHA, BETA, BIR, IDIM, JDIM, ITMDIM) 

SECOND  HALF  STEP 

BBIIN=BBIOUT 

BBJIN=BBJOUT 

CALL  RK4 (T+DT2,DT2,BBIIN,BBJ1N,BBIA,BBJA,AALAM, V, VM, 

1  TIMTAG, ALPHA, BETA, BIR, IDIM, JDIM, ITMDIM) 

TAKE  LARGE  STEP 

CALL  RK4 (TSAV,DT,BBISAV,BBJSAV,BBIB,BBJB,AALAM,V,''M, 

1  TIMTAG, ALPHA, BETA, BIR, IDIM, JDIM, ITMDIM) 

EVALUATE  ACCURACY 

ERRMAX=0. 

BIERR=BBIB-BBIA 

ERRMAX=MAX (ERRMAX, ABS (BIERR/BBISCL) ) 

BJERR=BBJB-BBJA 

ERRMAX=MAX (ERRMAX, ABS (BJERR/BBJSCL) ) 

SCALE  RELATIVE  TO  REQUIRED  TOLERANCE 
ERRMAX=ERRMAX / EP S 
IF (ERRMAX. GT. ONE)  THEN 

ERROR  TOO  LARGE,  REDUCE  STEPSIZE 
DT=SAFETY*DT* (ERRMAX**PSHRNK) 

GO  TO  10 

FOR  ANOTHER  TRY 

ELSE 

DTUSED-DT 

IF ( ERRMAX. GT.ERRCON)  THEN 

DTNEXT=SAFETY*DT* (ERRMAX* *PGROW) 

ELSE 

DTNEXT=4 . *DT 
END  IF 
END  IF 

PUT  IN  FIFTH  ORDER  CORRECTION 

BBI»BBIA+BIERR*FCOR 

IF (BBI.GT. REAL (IDIM) )  BBI=REAL (IDIM) 
BBJ=BBJA+BJERR*FCOR 


RETURN 

END 

SUBROUTINE  RK4 (T, DT, BBIIN, BBJIN, BBIOUT, BBJOUT, AALAM, V, VM, TIMTAG, 
1  ALPHA, BETA, BIR, IDIM, JDIM, ITMDIM) 

C 

C  VERSION  1.00  DATE:  12.30.87 

C 

C  PURPOSE:  SUBROUTINE  TO  ADVANCE  ONE  PARTICLE  LOCATION  ONE  TIME 
C  STEP  DT  USING  4TH  ORDER  RUNGE  KUTTA  ALGORITHM. 

C 

C  INPUT: 


MSM36490 

MSM36500 

MSM36510 

MSM36520 

MSM36530 

MSM36540 

MSM36550 

MSM36560 

MSM36570 

MSM36580 

MSM36590 

MSM36600 

MSM36610 

MSM36620 

MSM36630 

MSM36640 

MSM36650 

MSM36660 

MSM36670 

MSM36680 

MSM36690 

MSM36700 

MSM36710 

MSM36720 

MSM36730 

MSM36740 

MSM36750 

MSM36760 

MSM36770 

MSM36780 

MSM36790 

MSM36800 

MSM36810 

MSM36820 

MSM36830 

MSM36840 

MSM36850 

MSM36860 

MSM36870 

MSM36880 

MSM36890 

MSM36900 

MSM36910 

MSM36920 

MSM36930 

MSM36940 

MSM36950 

MSM36960 

MSM36970 

MSM36980 

MSM36990 

MSM37000 

MSM37010 

MSM37020 

MSM37030 

MSM37040 

MSM37050 

MSM37060 

MSM37070 

MSM37080 

MSM37090 

MSM37100 

MSM37110 

MSM37120 


msml.for 


c 

c 

c 


BBIIN 

BBJIN 

AALAM 

V 

VM 

TIMTAG 

ALPHA 

BETA 

BIR 

IDIM 

JDIM 

ITMDIM 

OUTPUT : 

BBIOUT 

BBJOUT 


TIME  PARAMETER  MSM37130 

TIME  STEP,  DT.LT.O  MOVES  PARTICLES  BACK  IN  TIME  MSM37140 
DT.GT.O  MOVES  PARTICLES  FORWARD  MSM37150 

CURRENT  I  LOCATION  OF  PARTICLE  MSM37160 

CURRENT  J  LOCATION  OF  PARTICLE  MSM37170 

ENERGY  INVARIANT  OF  PARTICLE  MSM37180 

ELECTRIC  POTENTIAL  ARRAY  (VOLTS)  MSM37190 

(FLUX  TUBE  VOLUME) **-2/3  ARRAY  (RE/NT) **-2/3  MSM37200 

VECTOR  GIVING  UNIVERSAL  TIMES  FOR  WHICH  DATA  ARRAYS  MSM37210 


ARE  GIVEN 

LATITUDINAL  GRID  SPACING  VECTOR 

LOCAL  TIME  GRID  SPACING  VECTOR 

lONSOPHERIC  MAGNETIC  FIELD  STRENGTH 

NUMBER  OF  LATITUDINAL  GRID  POINTS 

NUMBER  OF  LOCAL  TIME  GRID  POINTS  +  WRAPAROUND 

MAX  NUMBER  OF  TEMPORAL  GRID  POINTS 


COMPUTED 

COMPUTED 


I  LOCATION  AT  END  OF  TIME  STEP 
J  LOCATION  AT  END  OF  TIME  STEP 


PROGRAMMER:  R.  W.  SPIRO 


MSM37220 

MSM37230 

MSM37240 

MSM37250 

MSM37260 

MSM37270 

MSM37280 

MSM37290 

MSM37300 

MSM37310 

MSM37320 

MSM37330 

MSM37340 


C 

C 

C 


C 

C 

C 


MSM37350 

ABRAMOWITZ  AND  STEGUN,  HANDBOOK  OF  MATHEMATICAL  FUNCTIONSMSM37360 
NATIONAL  BUREAU  OF  STANDARDS,  1970.  P.  896,  SECT.  25 . 5 . 10MSM37370 

MSM37380 
MSM37390 
MSM37400 
MSM37410 
MSM37420 
MSM37430 
MSM37440 
MSM37450 
MSM37460 
MSM37470 
MSM37480 
MSM37490 
MSM37500 
MSM37510 
MSM37520 
MSM37530 
MSM37540 
MSM37550 
MSM37560 
MSM37570 
MSM37580 
MSM37590 
MSM37600 
MSM37610 
MSM37620 
MSM37630 
MSM37640 
MSM37650 
MSM37660 
MSM37670 
MSM37680 
MSM37690 
MSM37700 
MSM37710 
MSM37720 
MSM37730 
MSM37740 
MSM37750 
MSM37760 


REFERENCE : 


COMMON  /GRID/  DLAM,DPSI, RI, JWRAP 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT,  LUBNDI.,  LUPDAT,  LUVN,  LUVS,  LIONEG,  LIONNO,  LUENCH 

DIMENSION  ALPHA (IDIM) ,  BETA(IDIM),  BIR (IDIM, JDIM) 

DIMENSION  V(IDIM, JDIM, ITMDIM) , VM ( IDIM, JDIM,  ITMDIM) , TIMTAG (ITMDIM) 
DIMENSION  BITEMP (4) ,  BJTEMP(4) 


EVALUATE  DERIVATIVE  AT  TIME=T,  LOCATION= (BBI, BBJ) 

BT=TNORML (T, TIMTAG, ITMDIM) 

BIUSE-BBIIN 

BJUSE=BBJIN 

CALL  VLOCTY (BIUSE, BJUSE, BT, AALAM, ALPHA, BETA, BIR, V, VM, IDIM, JDIM, 
1  ITMDIM, DBIDT,DBJDT) 

BITEMP ( 1 ) =DT*DBIDT 
BJTEMP (1)=DT*DBJDT 


EVALUATE  DERIVATIVE  AT  TIME=T+DT/2, 


LOCATION^ (BBIIN+BITEMP (1) /2, 
BBJIN+BJTEMP (1) /2) 


BT=TNORML (T+DT/2 . , TIMTAG, ITMDIM) 

BIUSE=BBIIN+ . 5*BITEMP (1 ) 

BJUSE=BBJIN+.5*BJTEMP (1) 

CALL  VLOCTY  (BIUSE,  BJUSE,  BT,  .’J^LAM,  ALPHA,  BETA,  BIR,  V,  VM,  IDIM,  JDIM, 
1  ITMDIM, DBIDT,DBJDT) 

BITEMP (2)=DT*DBIDT 
BJTEMP ( 2 ) =DT*DB JDT 

EVALUATE  DERIVATIVE  AT  TIME=T+DT/2,  LOCATION= (BBIIN+BITEMP (2) /2, 

BBJIN+BJTEMP (2) /2) 

BIUSE-BBIIN+ . 5*BITEMP (2) 

BJUSE-BBJIN+. 5*BJTEMP (2) 

CALL  VLOCTY (BIUSE, BJUSE, BT, AALAM, ALPHA, BETA, BIR, V, VM, IDIM, JDIM, 
1  ITMDIM, DBIDT,DBJDT) 

BITEMP (3) =DT*DBIDT 


oooo  oooooooooooooooooooooooooooooooo  ooo  ooo 


msml.for 


BJTEMP (3) =DT*DBJDT 


EVALUATE  DERIVATIVE  AT  TIME=T+DT,  LOCATION= (BBIIN+BITEMP (3) , 

BBJIN+BJTEMP(3) ) 

BT-TNORML (T+DT, TIMTAG, ITMDIM) 

BIUSE-BBIIN+BITEMP (3) 

BJUSE=BBJIN+BJTEMP (3) 

CALL  VLOCTY (BIUSE, BJUSE, BT, AALAM, ALPHA, BETA, BIR, V, VM, IDIM, JDIM, 
1  ITMDIM, DBIDT,DBJDT) 

BITEMP (4)=DT*DBIDT 
BJTEMP (4) =DT*DBJDT 


COMPUTE  NEW  LOCATIONS  AT  END  OF  TIME  STEP 

BBIOUT=BBIIN+ (BITEMP (l)+2.* (BITEMP (2) +BITEMP (3) ) +BITEMP (4) ) /6. 
BBJOUT=BBJIN+ (BJTEMP (1) +2. * (BJTEMP (2)+BJTEMP (31) +BJTEMP (4) ) /6. 
RETURN 
END 

SUBROUTINE  TCHK (T, TSTOP, DTNOM, BBI, BBJ, lEUSE, ETABEG, IDIM, JDIM, 

1  IEDIM,ETANIL, lEXIT) 


VERSION  1.00 


DATE:  01.11.88 


PURPOSE:  SUBROUTINE  TO  CHECK  WHETHER  TIME  BOUNDARY  WAS  CROSSED  THIS 

TIME  STEP.  IS  SO,  SET  IEXIT=1  AND  INTERPOLATE  TO  FIND 
ETABEG  AT  LOCATION  (BBI, BBJ). 


INPUT: 

T 

TSTOP 

DTNOM 

BBI 

BBJ 

lEUSE 

ETABEG 

IDIM 

JDIM 

lEDIM 

OUTPUT : 

ETANIL 


lEXIT 


TIME 

TIME  AT  WHICH  TO  END  PARTICLE  TRACEBACK 
NOMINAL  TIME  STEP  TO  BEGIN  TRACES. 

I  LOCATION  OF  PARTICLE 
J  LOCATION  OF  PARTICLE 
ENERGY  INDEX  OF  PARTICLS 

INITIAL  ETA  DISTRIBUTION  (IE.,  AT  T=TSTOP) 

NUMBER  OF  LATITUDINAL  GRID  POINTS 

NUMBER  OF  LOCAL  TIME  GRID  POINTS  (INCL  WRAPAROUND) 
NUMBER  OF  ENERGY  SPECIES 


ETABEG  VALUE  AT  LOCATION  (BBI, BBJ)  AT  TIME  T  FOR 
ENERGY  SPECIES  lEUSE  IF  PARTICLE  HAS  CROSSED 
TIME  BOUNDARY 

SET  EQUAL  TO  1  IF  PARTICLE  HAS  CROSSED  TIME  BNDY 


PROGRAMMER:  R.  W.  SPIRO 


COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
DIMENSION  ETABEG (IDIM, JDIM, lEDIM) 

IF  TIME  BOUNDARY  IS  CROSSED,  SET  IEXIT=1  AND  INTERPOLATE 
TO  FIND  ETABEG  AT  LOCATION  (BBI, BBJ) 

IF( (ABS (T-TSTOP) . LT . . 01 *ABS (DTNOM) ) .OR. 

1  (DTNOM. GT.O. . AND. T.GE. TSTOP) .OR. 

2  (DTNOM. LT.O. .AND. T.LE. TSTOP) )  THEN 


MSM37770 

MSM37780 

MSM37790 

MSM37800 

MSM37810 

MSM37820 

MSM37830 

MSM37840 

MSM37850 

MSM37860 

MSM37870 

MSM37880 

MSM37890 

MSM37900 

MSM37910 

MSM37920 

MSM37930 

MSM37940 

MSM37950 

MSM37960 

MSM37970 

MSM37980 

MSM37990 

MSM38000 

MSM38010 

MSM38020 

MSM38030 

MSM38040 

MSM38050 

MSM38060 

MSM38070 

MSM38080 

MSM38090 

MSM38100 

MSM38110 

MSM38120 

MSM38130 

MSM38140 

MSM38150 

MSM38160 

MSM38170 

MSM38180 

MSM38190 

MSM38200 

MSM38210 

MSM38220 

MSM38230 

MSM38240 

MSM38250 

MSM38260 

MSM38270 

MSM38280 

MSM38290 

MSM38300 

MSM38310 

MSM38320 

MSM38330 

MSM38340 

MSM38350 

MSM38360 

MSM38370 

MSM38380 

MSM38390 

MSM38400 


oooo  o  ooo  ooo 


msml.for 

IEXIT=1 

RIEUSE=REAL (lEUSE) 

ETANIL=G3NTRP (ETABEG, IDIM, JDIM, lEDIM, BBI , BBJ, RIEUSE) 

END  IF 
C 

RETURN 

END 

FUNCTION  TNORML(TT,TIMTAG, ITMMAX) 

C 

C  VERSION  1.00  DATE:  12.16.87 

C 

C  PURPOSE:  FUNCTION  TO  CALCULATE  RUN -NORMALIZED  TIME  CORRESPONDING 
C  TO  TIME  TT 

C 

C  INPUT: 

C  TT 

C  TIMTAG 

C 

C  ITMMAX 

C 

C  OUTPUT: 

C  TNORML 

C 
C 

C  PROGRAMMER;  R.  W.  SPIRO 
C 
C 
C 

COMMON  /LUNIT/LUERR, LUPIEN,LUCORD,LUPRNT,LUIDAT,LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
DIMENSION  TIMTAG (ITMMAX) 

DO  10  1=1,ITMMAX-1 

IF( (TT.GE. TIMTAG (I) . AND . TT . LE . TIMTAG (I+l ) ) .OR. 

1  (TT.LE.TIMTAG(I) .AND. TT.GE. TIMTAG(I+1) ) )  THEN 

II«I 

GO  TO  20 
END  IF 
10  CONTINUE 

TIME  TT  NOT  WITHIN  TIMTAG  RANGE 

WRITE (LUERR, *) 'TT  NOT  WITHIN  TIMTAG  RANGE,  TT=  ' , TT 
WRITE(LUERR,*) 'TIMTAG(1)=' ,TIMTAG(1) 

WRITE (LUERR, *) ' ITMMAX=' , ITMMAX 

WRI TE ( LUERR , * ) ' T IMT AG ( I TMMAX ) = ' , T I MTAG ( I TMMAX ) 

WRITE (LUERR, *)  'STOPPING  PROGRAM  IN  FUCTION  TNORML' 

STOP 

LOCALIZED  TT  TO  WITHIN  THE  RIGHT  TIME  RANGE 
20  CONTINUE 

TNORML=REAL(II)+ (TT-TIMTAG(II) ) / (TIMTAG (II+l ) -TIMTAG (II ) ) 

RETURN 
END 

SUBROUTINE  VLOCTY (BBII , BBJJ, BT, AALAM, ALPHA, BETA, BIR, V, VM, 

1  IDIM, JDIM, ITMDIM,DBIDT,DBJDT) 

VERSION  1.00  DATE:  12.16.87 

I.OIA  02.02.89 


TIME  IN  SECONDS 

VECTOR  GIVING  TIMES  FOR  WHICH  MODEL  ARRAYS 
ARE  CALCULATED 

NUMBER  OF  TEMPORAL  GRID  POINTS  USED 


NON-INTEGER  TIME  INDEX  CORRESPONDING  TO 
TIME  TT 


MSM38430 

MSM38440 

MSM38450 

MSM38460 

MSM38470 

MSM38480 

MSM38490 

MSM38500 

MSM38510 

MSM38520 

MSM38530 

MSM38540 

MSM38550 

MSM38560 

MSM38570 

MSM38580 

MSM38590 

MSM38600 

MSM38610 

MSM38620 

MSM38630 

MSM38640 

MSM38650 

MSM38660 

MSM38670 

MSM38680 

MSM38690 

MSM38700 

MSM38710 

MSM38720 

MSM38730 

MSM38740 

MSM38750 

MSM38760 

MSM38770 

MSM38780 

MSM38790 

MSM38800 

MSM38810 

MSM38820 

MSM38830 

MSM38840 

MSM38850 

MSM38860 

MSM38870 

MSM38880 

MSM38890 

MSM38900 

MSM38910 

MSM38920 

MSM38930 

MSM38940 

MSM38950 

MSM38960 


MSM38970 


MSM38980 

MSM38990 

MSM39000 

MSM39010 

MSM39020 

MSM39030 

MSM39040 


oo  n  oooo  oo 


C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PURPOSE : 


msml.for 

SUBROUTINE  TO  COMPUTE  I  AND  J  COMPONENTS  OF  PARTICLE 
VELOCITY  WITH  ENERGY  INVARIANT  AALAM  AT  LOCATION 
(BBI,BBJ)  AT  NORMALIZED  TIME  BT. 
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INPUT : 
BBII 
BBJJ 
BT 

AALAM 

ALPHA 

BETA 

BIR 

V 

VM 

IDIM 

JDIM 

ITMDIM 

OUTPUT; 

DBIDT 

DBJDT 


MSM39050 
MSM39060 
MSM39070 
MSM39080 
MSM39090 
MSM39100 
MSM39110 
MSM39120 
MSM39130 
MSM39140 
MSM39150 
MSM39160 
MSM39170 

(FLUX  TUBE  VOLUME) **-2/3  ARRAY  (RE/NT) **-2/3MSM39180 


I  LOCATION  OF  PARTICLE 
J  LOCATION  OF  PARTICLE 
NORMALIZED  TIME 

ENERGY  INVARIANT  (EV  (RE/NT) **2/3) 
LATITUDINAL  GRID  SPACING  VECTOR 
LONGITUDINAL  GRID  SPACING  VECTOR 
IONOSPHERIC  RADIAL  MAGNETIC  FIELD  STRENGTH 
ELECTRIC  POTENTIAL  ARRAY  (VOLTS) 


1ST  (LAT)  DIMENSION  OF  V,  VM,  AND  BIR 
2ND  (LONG)  DIMENSION  OF  V,VM,  AND  BIR 
3RD  (TIME)  DIMENSION  OF  V  AND  VM 


I 

J 


(LAT) 

(LAT) 


VELOCITY  OF 
VELOCITY  OF 


PARTICLE 

PARTICLE 


(I  UNITS/SEC) 
(J  UNITS/SEC) 


PROGRAMMER;  R.  W  SPIRO 


COMMON  /GRID/  DLAM, DPSI , RI , JWRAP 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO,  LUENCH 

DIMENSION  ALPHA (IDIM) , BETA (IDIM) , BIR (IDIM, JDIM) 

DIMENSION  V (IDIM, JDIM, ITMDIM) , VM (IDIM, JDIM, ITMDIM) 

DIMENSION  DVDI2 (2,2) ,DVDJ2 (2,2) 


BBI=BBII 

BBJ=BBJJ 

CALL  MODFIX (BB J, JDIM, JWRAP ) 
INTERPOLATE  GRID  ARRAY  FOR  LOCATION 


(BBI,BBJ) 


BIR2-G3NTRP (BIR, IDIM, JDIM, 1 , BBI , BB J, 1 . ) 

ALPH2“G3NTRP (ALPHA, IDIM, 1,1, BBI , 1 . , 1 . ) 

BETA2-G3NTRP (BETA, IDIM, 1 , 1 , BBI , 1 . , 1 . ) 

COMPUTE  DVEFDI  AND  DVEFDJ  AT  NORMALIZED  TIME  BT  FOR  GRID  PTS 
SURROUNDING  (BBI,BBJ) 

I-BBI 

FI -REAL (I) 

J-BBJ 

FJ=REAL(J) 

DO  10  11=1,2 
IUSE-I+II-1 

IF (lUSE.GT. IDIM)  lUSE-IDIM 
DO  20  JJ=1,2 
JUSE-J+JJ-1 

DVDI2 (II, JJ) -DVEFDI ( lUSE, JUSE, BT, AALAM, V, VM, IDIM, JDIM, ITMDIM) 
DVDJ2 (II, JJ) -DVEFDJ (lUSE, JUSE, BT, AALAM, V,VM, IDIM,  JDIM, ITMDIM) 
20  CONTINUE 
10  CONTINUE 

INTERPOLATE  DVDI2  AND  DVDJ2  FOR  LOCATION  (BBI,BBJ) 


MSM39190 

MSM39200 

MSM39210 

MSM39220 

MSM39230 

MSM39240 

MSM39250 

MSM39260 

MSM39270 

MSM39280 

MSM39290 

MSM39300 

MSM39310 

MSM39320 

MSM39330 

MSM39340 

MSM39350 

MSM39360 

MSM39370 

MSM39380 

MSM39390 

MSM39400 

MSM39410 

MSM39420 

MSM39430 

MSM39440 

MSM39450 

MSM39460 

MSM39470 

MSM39480 

MSM39490 

MSM39500 

MSM39510 

MSM39520 

MSM39530 

MSM39540 

MSM39550 

MSM39560 

MSM39570 

MSM39580 

MSM39590 

MSM39600 

MSM39610 

MSM39620 

MSM39630 

MSM39640 

MSM39650 

MSM39660 

MSM39670 

MSM39680 


msml.for 


c 

DVDI= ( 1 . -BBJ+F J) * { ( 1 . -BBI+FI ) *DVDI2 (1,1)+ (BBI -FI ) *DVDI2 (2,1)) 

1  +  (BBJ-FJ)*((1.-BBI+FI)*DVDI2(1,2)+(BBI-FI)*DVDI2(2,2)) 

C 

DVDJ=(1.-BBJ+FJ) * { (1. -BBI+FI) *DVDJ2 (1, 1) + (BBI-FI) *DVDJ2 (2,1) ) 

1  +  (BBJ-FJ) * ((1. -BBI+FI) *DVDJ2 (1,2)+ (BBI-FI) *DVDJ2 (2, 2)) 

C 

C  COMPUTE  VELOCITIES 
C 

DBIDT=DVDJ*1000./ (BIR2*ALPH2*BETA2*DLAM*DPSI*RI**2) 

DBJDT— DVDI*1000./ (BIR2*ALPH2*BETA2*DLAM*DPSI*RI**2) 

C 

RETURN 

END 

SUBROUTINE  RDGRID (IDIM, JDIM, ALPHA, BETA, TETA,  PHI , COLAT, BIR, SINI ) 

C 

C  VERSION  1.0  DATE:  01.23.88 

C 

C  PROGRAMMER:  R.  W.  SPIRO 
C 

C  PURPOSE:  READ  GRID  SYSTEM  COORDINATES  AND  CALCULATE  ESSENTIAL  GRID 
C  QUANTITIES 

C 

COMMON  /GRID/  DLAM,DPSI,RI, JWRAP 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
C 

DIMENSION  ALPHA (IDIM) , BETA (IDIM) , TETA (IDIM) ,PHI (JDIM) 

DIMENSION  COLAT (IDIM, JDIM) , SIR (IDIM, JDIM) , SINI (IDIM, JDIM) 

C 

CHARACTER  ID (2) 

PI=ATAN2(0.,-1.) 

JWRAP  =  3 
C 

C  READ  GRID  PARAMETERS 
C 

OPEN (UNIT-LUCORD, FILE=' COORD' , STATUS=' OLD'  ) 

C 

READ (LUCORD, 1000)  ID, OFFSET, DLAM, DPSI, RI, RE 

1000  F0RMAT(2A4,1X,5(E12.6,1X) ) 

READ (LUCORD, 1001) TETA, ALPHA, BETA, PHI 

1001  FORMAT(10(E12.6,1X) ) 

C 

DO  10  I-1,IDIM 
DO  20  J=1,JDIM 

COSTET=COS (TETA (I) ) *COS (OFFSET) +SIN (TETA (I) ) *COS (PHI (J) ) * 

1  SIN (OFFSET) 

BIR(I, J) =62000. ‘COSTET 
COLAT (I, J) “ACOS (COSTET) 

SINI ( I , J) =2 . *COSTET/SQRT ( 1 , +3 . *COSTET*  *2 ) 

20  CONTINUE 
10  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  MLTSET(ISEC, IDIM, JDIM, ALOCT) 

C 

C  VERSION  1.0  DATE:  01.23.88 

C 

C  PROGRAMMER:  R.  W.  SPIRO 
C 

C  PURPOSE:  CALCULATE  TIME  DEPENDENT  ALOCT  OF  ROTATING  GRID  PTS 


MSM39690 

MSM39700 

MSM39710 

MSM39720 

MSM39730 

MSM39740 

MSM39750 

MSM39760 

MSM39770 

MSM39780 

MSM39790 

MSM39800 

MSM39810 

MSM39820 

MSM39830 

MSM39840 

MSM39850 

MSM39860 

MSM39870 

MSM39880 

MSM39890 

MSM39900 

MSM39910 

MSM39920 

MSM39930 

MSM39940 

MSM39950 

MSM39960 

MSM39970 

MSM39980 

MSM39990 

MSM40000 

MSM40010 

MSM40020 

MSM40030 

MSM40040 

MSM40050 

MSM40060 

MSM40070 

MSM40080 

MSM40090 

MSM40100 

MSM40110 

MSM40120 

MSM40130 

MSM40140 

MSM40150 

MSM40160 

MSM40170 

MSM40180 

MSM40190 

MSM40200 

MSM40210 

MSM40220 

MSM40230 

MSM40240 

MSM40250 

MSM40260 

MSM40270 

MSM40280 

MSM40290 

MSM40300 

MSM40310 

MSM40320 


msml.for 


c 

C  INPUTS : 

C  ISEC  TIME  (SECONDS) 

C  IDIM  I  DIMENSION 

C  JDIM  J  DIMENSION 

C 

C  OUTPUT: 

C  ALOCT  LOCAL  TIME  ARRAY  CORRESPONDING  TO  T=ISEC 

C 

COMMON  /GRID/  DLAM, DPSI, RI, JWRAP 
DIMENSION  ALOCT (IDIM, JDIM) 

C 

PI-ATAN2(0.,-1.) 

DPHI-2 . *PI/REAL ( JDIM-JWRAP) 

DPHIDT-2.*PI/86400, 

T-REAL(ISEC) 

C 

DO  10  I-1,IDIM 
DO  10  J-1,JDIM 

ALOCT (I, J) -REAL ( J-3) *DPHI+T*DPHIDT 

1F(AL0CT(I, J) .GT.2.*PI)  ALOCT (I, J) -ALOCT (I, J) -2 . *PI 
1F(AL0CT(I, J) .LT.O.)  ALOCT (I , J) -ALOCT (I, J) +2 . *PI 
10  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  VMLSET (ITMCUR, VM, BIR, SINI , IDIM, JDIM, ITMDIM, VMLOSS) 

C 

C  VERSION  1.0  DATE:  01.23.88 

C 

C  PROGRAMMER:  R.  W.  SPIRO 
C 

C  PURPOSE:  COMPUTE  VMLOSS  ARRAY  FOR  ITMCUR 
C 

DIMENSION  VMLOSS (IDIM, JDIM, ITMDIM) , BIR (IDIM, JDIM) , SINI (IDIM, JDIM) 
DIMENSION  VMdDIM,  JDIM,  ITMDIM) 

C 

DO  10  I-1,IDIM 
DO  10  J-1,JDIM 

VMLOSS (I, J, ITMCUR) -(SINI ( I , J) /BIR (I,  J) ) *VM (I ,  J,  ITMCUR) **2 
10  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  FNDBND (ITMCUR, COLAT, ALOCT, A2,B2,DX2,DY2, IDIM, JDIM, 

1  ITMDIM, BNDLOC) 

C 

C  VERSION  1.0  DATE:  01.23.88 

C 

C  PROGRAMMER:  R.  W.  SPIRO 
C 

C  PURPOSE:  COMPUTE  TIME  DEPENDENT  OUTER  BOUNDARY  LOCATION 
C 

COMMON  / LUNI T / LUERR , LUP I EN , LUCORD , LUPRNT , LUI DAT , LUHDYE , 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM,  LUFLX, 

2  LUEFLX,  LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIM, LUALOC, 

3  LUCOLT,  LUBNDL,  LUPDAT,  LUVN,  Lf^VS,  LIONEG,  LIONNO,  LU  iNCH 
C 

DIMENSION  COLAT ( IDIM, JDIM) , ALOCT (IDIM, JDIM) 

DIMENSION  BNDLOC (JDIM, ITMDIM) 

C 

PI  -  ATAN2(0.,-1.) 

DO  10  J-1,JDIM 
DO  20  I-1,IDIM-1 


MSM40330 

MSM40340 

MSM40350 

MSM40360 

MSM40370 

MSM40380 

MSM40390 

MSM40400 

MSM40410 

MSM40420 

MSM40430 

MSM40440 

MSM40450 

MSM40460 

MSM40470 

MSM40480 

MSM40490 

MSM40500 

MSM40510 

MSM40520 

MSM40530 

MSM40540 

MSM40550 

MSM40560 

MSM40570 

MSM40580 

MSM40590 

MSM40600 

MSM40610 

MSM40620 

MSM40630 

MSM40640 

MSM40650 

MSM40660 

MSM40670 

MSM40680 

MSM40690 

MSM40700 

MSM40710 

MSM40720 

MSM40730 

MSM40740 

MSM40750 

MSM40760 

MSM40770 

MSM40780 

MSM40790 

MSM40800 

MSM40810 

MSM40820 

MSM40830 

MSM40840 

MSM40850 

MSM40860 

MSM4CB70 

MSM40880 

MSM40890 

MSM40900 

MSM40910 

MSM40920 

MSM40930 

MSM40940 

MSM40950 

MSM40960 


ooDO  non  ooooooooooooonoooooooo  o  o  o  o  oo 


msml.for 


IUSE=I  MSM40970 

THETAB=THET(A2,B2,DX2,DY2,ALOCT(I+l,  J) ) *PI/180.  MSM40980 

IF(C0LAT(I+1, J) .GE.THETAB)  GO  TO  30  MSM40990 

20  CONTINUE  MSM41000 

MSM41010 

ERROR  EXIT  MSM41020 

WRITE (LUERR, *)  'ERROR  IN  FFNDBND'  MSM41030 

WRITE (LUERR, *)  ' THETAB=' , THETAB, ' J=' , J, ' 1=' , I  MSM41040 

WRITE (LUERR, *)  'STOPPING  PGM'  MSM41050 

STOP  MSM41060 

MSM41070 

30  CONTINUE  MSM41080 

MSM41090 

THETAC=THET ( A2 , B2 , DX2 , DY2 , ALOCT (IUSE,J))*PI/180.  MSM4 1100 

BNDLOC(J,ITMCUR)=(REAL(IUSE) * (COLAT (IUSE+1, J) -THETAB)+  MSM41110 

1  REAL(IUSE+1)  *  (THETAC-COLATdUSE,  J)  )  )  /  MSM41120 

2  (COLAT(IUSE+l,  J) -COLATdUSE,  J) -THETAB+THETAC)  MSM41130 

MSM41140 

10  CONTINUE  MSM41150 

MSM41160 

RETURN  MSM41170 

END  MSM41180 

SUBROUTINE  OUTP (R, ISIZE, JSI2E, IBEG, lEND, IINC, JBEG, JEND, JINC,  MSM41190 

S  XSCALE, TITLE, NTP,NCOL)  MSM41200 

MSM41210 

AUTHOR:  R.W.  SPIRO  LAST  MODIFIED:  06-25-85  MSM41220 

MSM41230 

**********************************************************************  MSM41240 
DESCRIPTION  OF  INPUT  PARAMETERS  MSM41250 

*********************************************************************  MSM41260 

R (ISIZE,  JSI2E) “ARRAY  TO  BE  OUTPUT  MSM41270 

THIS  SUBROUTINE  IS  ABLE  TO  OUTPUT  SELECTED  ELEMENTS  OF  ARRAY  MSM41280 

IBEG“  INITIAL  I  VALUE  TO  BE  OUTPUT  ■MSM41290 

lEND-  FINAL  I  VALUE  TO  BE  OUTPUT  MSM41300 

IINC-  I  VALUE  INCREMENT  FOR  OUTPUT  MSM41310 

(NOTE:  (lEND-IBEG) /IINC  SHOULD  BE  AN  INTEGER)  MSM41320 

JBEG, JEND,  AND  JINC  ARE  DEFINED  SIMILARLY  MSM41330 

SCALE-SCALE  FACTOR  MSM41340 

IF (SCALE. EQ. 0. )  SCALE  IS  CALCULATED  TO  GIVE  BEST  DISPLAY  MSM41350 

ALL  ELEMENTS  OR  ARRAY  ARE  DIVIDED  BY  SCALE  BEFORE  BEING  OUTPUTMSM41360 


30  CONTINUE 

THETAC-THET ( A2 , B2 , DX2 , DY2 , ALOCT ( lUSE, J))*PI/180. 

BNDLOC ( J, ITMCUR) = (REAL (lUSE) * (COLAT (IUSE+1, J) -THETAB) + 

1  REALdUSE+l)  *  (THETAC-COLATdUSE,  J)  )  )  / 

2  (COLAT (IUSE+1,J) -COLAT (I USE, J) -THETAB+THETAC) 

10  CONTINUE 

RETURN 

END 

SUBROUTINE  OUTP (R, ISIZE, JSI2E, IBEG, lEND, IINC,  JBEG, JEND,  JINC, 

S  XSCALE, TITLE, NTP,NCOL) 


AUTHOR:  R.W.  SPIRO 


LAST  MODIFIED:  06-25-85 


TITLE-CHARACTER  STRING  THAT  IDENTIFIES  THE  ARRAY  BEING  OUTPUT 
NTP-  OUTPUT  UNIT  NUMBER 

NCOL-  NUMBER  OF  COLUMNS  FOR  OUTPUT  DEVICE  (80  OR  132) 

PARAMETER  (JCOL-16) 

DIMENSION  R (ISIZE, JSIZE) ,  Y(JCOL) 

REAL* 8  SUMO,  SUMl,  SUM2,  TERM,  AVE,  SD 
CHARACTER  TITLE  *(*) 

INITIALIZATION 

SCALE-XSCALE 
ISCLMX— 12 
SUMO-O.O 
SUMl-O.O 
SUM2-0 . 0 
MXLINE-57 
JJCOL-(NCOL-4)  /  8 


CALCULATE  SIZE  OF  PRINTOUT  ARRAY  (NI  BY  NJ) 


MSM41370 

MSM41380 

MSM41390 

MSM41400 

MSM41410 

MSM41420 

MSM41430 

MSM41440 

MSM41445 

MSM41450 

MSM41460 

MSM41470 

MSM41480 

MSM41490 

MSM41500 

MSM41510 

MSM41520 

MSM41530 

MSM41540 

MSM41550 

M3M41560 

MSM41570 

MSM41580 

MSM41590 


ooooo  ooooo  oo  oooo 


msmi.for 


NI- (lEND-IBEG) /IINC+1 
NJ- ( JEND-JBEG) / JINC+1 

IF  SCALE-0.  THEN  COMPUTE  AUTO  SCALE  FACTOR 
IF ( SCALE. EQ.O.)  THEN 

DETERMINE  MAXIMUM  #  OF  PLACES  TO  LEFT  OF  DECIMAL  PT 
DO  10  I-IBEG, lEND, IINC 
DO  10  J-JBEG, JEND, JINC 

IF(R(I, J) .NE.O. .AND.ABS (R(I, J) ) .GT.l.E-36)  THEN 
TEST-LOGIO (ABS (R(I, J) ) ) 

IF{TEST.GE.O.)  THEN 
TEST-TEST+. 000001 
ELSE 

TEST-TEST-. 999999 
END  IF 

ITEST-TEST 

ELSE 

ITEST-0 
END  IF 

IF(R(I, J) .LT.O. )  ITEST-ITEST+1 
ISCLMX-MAXO (ISCLMX, ITEST) 

10  CONTINUE 

DETERMINE  SCALE  FACTOR  SUCH  THAT  MAX  #  OF  PLACES  TO  LEFT  OF 
DECIMAL  POINT  IS  3. 

IPOWER-ISCLMX-2 
SCALE- 10.**IPOWER 
ELSE 

IPOWER-NINT (LOGIO (SCALE) ) 

END  IF 


COMPUTE  MEAN  AND  STD  DEVIATION  OF  OUTPUTTED  ARRAY  ELEMENTS 


DO  20  I=1,ISIZE 
DO  20  J=1,JSIZE 
TERM=R(I, J) 

SUMO-SUMO+1. 

IF  (ABS(TERM) .LT.1.E-20)  GO  TO  20 
SUMl-SUMl+TERM 
SUM2-SUM2+TERM**2 
20  CONTINUE 

AVE-SUMl/SUMO 

SD-SQRT ( {SUM2-SUM0*AVE**2) / (SUMO-1 . ) ) 


OUTPUT  DATA 


JSTART-JBEG 
I START- I BEG 
IFINAL-IEND 
IUTT-0 

WRITE (NTP, 810)  TITLE, IPOWER, lUTT, AVE, SD 
810  FORMAT (' 0' , 4X,A, ' / (1 .E' , 12, ' ) ' , 4X, 'UT-' , I6,2X, 'AVE-' , 1PE15.8,2X, 
$  'SD=',E15.8) 

LCOUNT-0 

C 

C 

C  BEGIN  OUTPUT  LOOP 

C 

C 


MSM41600 

MSM41610 

MSM41620 

MSM41630 

MSM41640 

MSM41650 

MSM41660 

MSM41670 

MSM41680 

MSM41690 
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30  CONTINUE 

JFINAL- ( JJCOL-1 ) * JINC+ JSTART 
IF(JFINAL.GT. JEND)  JFINAL=JEND 

FOLLOWING  IS  MAIN  IF  STATEMENT  IN  LOOP 


IF (JSTART. LE. JEND)  THEN 


OUTPUT  A  BLOCK 
IF (MXLINE-LCOUNT.LE. 5)  THEN 

START  A  NEW  PAGE 

IUTT=0 

WRITE (NTP, 810)  TITLE, IPOWER, lUTT, AVE, SD 
LCOUNT-0 
END  IF 

WRITE (NTP, 830)  ( JJ, JJ= JSTART, JFINAL, JINC) 

830  FORMAT (' 0' ,3X, 16 (5X, 13) ) 

LCOUNT=LCOUNT+2 
DO  40  II>=ISTART,  IFINAL,  IINC 
ICOUNT=LCOUNT+l 
IF(LCOUNT.GT.MXLINE)  THEN 

START  A  NEW  PAGE 

IUTT=0 

WRITE (NTP, 810)  TITLE, IPOWER, lUTT, AVE, SD 
WRITE (NTP, 830)  ( JJ, JJ=JSTART, JFINAL, JINC) 

LCOUNT-2 
END  IF 
JCOUNT-0 

DO  50  JJ»JSTART, JFINAL,  JINC 
JCOUNT=JCOUNT+l 
Y(JCOUNT)=R(II, JJ) /SCALE 
50  CONTINUE 

WRITE (NTP, 840)  II, (Y ( JJ) , JJ=1 , JCOUNT) 

840  FORMAT (IX, 13, 16 (F8. 3)) 

40  CONTINUE 

JSTART=JFINAL+JINC 
I START- I BEG 
GO  TO  30 
END  IF 
RETURN 
END 

SUBROUTINE  HIEPAR 

PURPOSE:  SUBROUTINE  TO  COMPUTE  EMPIRICAL  MODEL  OF  MEV  ENERGY 

ELECTRONS.  THIS  ROUTINE  IS  A  DUMMY  TO  REPRESENT  THE 
TRUE  SUBROUTINE  TO  BE  FURNISHED  BY  D.  BAKER  OF  GSFC. 

RETURN 


SUBROUTINE  OUTPUT 

PURPOSE:  DUMMY  SUBROUTINE  TO  REPRESENT  ALGORITHM  TO  OUTPUT  MSM 

RESULTS  TO  ENVIRONMENTAL  DATA  BASE.  THIS  ROUTINE  WILL  BE 
THE  OUTPUT  INTERFACE  BETWEEN  THE  MSM  AND  THE  ENVIRONMENTAL 
DATA  BASE. 

RETURN 

END 

SUBROUTINE  AURLl (FKP, COLAT, ALOCT, LATDIM, LTDIM, AEFLUX, AEMEAN) 
Determines  the  number  and  energy  fluxes  given  Kp,  corrected 
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geomagnetic  latitude,  and  local  time 


FKP“The  most  recent  Kp  value 

COIiAT*An  array  listing  pertinent  colatitudes  (less  than  40  deg.) 

preferably  using  corrected  geomagnetic  coordinates 
ALOCT-An  array  listing  pertinent  magnetic  local  times 
LATDIM'DIMENSION  IN  LATITUDE 
LTDIM-DIMENSION  IN  LOCAL  TIME 

AEFLUX»The  integral  electron  energy  flux  given  in  units  of  ergs 
per  cm**2-sec  for  a  given  latitude  and  local  time 
AEMEAN-AVERAGE  ENERGY  IN  EV 

AFLUX“The  integral  electron  number  flux  given  in  units  of  inverse 
cm**2-sec  for  a  given  latitude  and  local  time 

PARAMETER ( I IDIM=62 , JJDIM=51 ) 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT,  LUIDAT,  LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX,  LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
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DIMENSION  ALOCT (LATDIM, LTDIM) , COLAT (LATDIM, LTDIM) , 

1  AEFLUX (LATDIM, LTDIM) , AFLUX (IIDIM, JJDIM) , AEMEAN (LATDIM, LTDIM) , 

2  RDC(2) ,H0DC(2) ,S1DC(2) ,S2DC(2) ,RCOS(6,2) ,RSIN(6,2) , 

3  HOCOS(6,2) ,H0SIN(6,2) ,S1C0S(6,2) , SISIN (6,  2)  ,  S2COS (6,  2)  , 

4  S2SIN(6,2) 

C 

PI-ACOS(-l.) 

c 

C  Read  off  the  model  coefficients  for  the  given  Kp 
CALL  FNDHDY (FKP, RDC, RCOS, RSIN, HODC, HOCOS, HOSIN, 

1  SIDC, SICOS, SISIN, S2DC, S2COS, S2SIN, 6,2) 

C 

DO  20  J=l, LTDIM 
DO  10  1=1, LATDIM 
C 

XLT=ALOCT(I, J) 

C 

C 

C  Determine  the  values  of  the  energy  flux  array 

CALL  ADDHDY (RDC, RCOS, RSIN, HODC, HOCOS, HOSIN, SIDC, SICOS, 

1  S1SIN,S2DC,S2C0S,S2SIN,6,2,1,XLT,C0LAT(I, J) , 

2  AEFLUX (I, J)) 

C 

C  Convert  units  from  keV/cm**2-ster-sec  to  erg/cm**2-sec 

AEFLUXd,  J)  =  (10.**AEFLUX(I,  J)  )  *PI*1 . 6021E-9 
C 
C 
C 

10  CONTINUE 

20  CONTINUE 
C 

DO  40  J=l, LTDIM 
DO  30  1=1, LATDIM 
C 

XLT=ALOCT(I, J) 

C 

C  Determine  the  values  of  the  number  flux  array 

CALL  ADDHDY (RDC, RCOS, RSIN, HODC, HOCOS, HOSIN, SIDC, SICOS, 

1  S1SIN,S2DC,S2C0S,S2SIN,6,2,2,XLT,C0LAT(I,J) , 

2  AFLUX (I, J)) 

C 

C  Convert  units  from  (ster-cm**2-sec) **-l  to  (cm**2-sec) **-l 

AFLUXd,  J)«(10.**AFLUX(I,  J)  )  *PI 

IF (AFLUX ( I , J) . NE . 0 . 0 ) AEMEAN ( I , J) =AEFLUX (I , J) /AFLUX (I , J) 
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AEMEANd,  J)=AEMEAN(I,  J)  *6.24E11 
30  CONTINUE 
40  CONTINUE 
C 

RETURN 

END 


SUBROUTINE  FNDHDY (FKP, RDC, RCOS, RSIN, HODC, HOCOS, HOSIN, 

1  SIDC, SICOS, SISIN, S2DC, S2COS, S2SIN, MDIM, NDIM) 

Find  and  read  the  pertinent  Fourier  coefficients 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBF'  D, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 

DIMENSION  RDC (NDIM) , HODC (NDIM) , SlDC (NDIM) , S2DC (NDIM) , 

1  RCOS (MDIM, NDIM) , RSIN (MDIM, NDIM) , HOCOS (MDIM, NDIM) , 

2  HOSIN (MDIM, NDIM) , SICOS (MDIM, NDIM) , SlSIN (MDIM, NDIM) , 

3  S2COS (MDIM, NDIM) ,S2SIN (MDIM, NDIM) 

DATA  IKPCHK  /-!/ 

IFKP2=NINT (FKP) 

IF(IFKP2.GT.6)  IFKP2=6 

IF  THESE  KP  COEFS  WERE  THE  LAST  READ,  DON'T  REREAD 
IF (IKPCHK. EQ.IFKP2)  GO  TO  99 

OPEN ( UNI T=LUHDYE, FILE*' HARDY' , STATUS*'OLD' ) 

IFdREWCK.NE.DTHEN 
GO  TO  10 

ELSE  IF  (IKPCHK. NE. IFKP2) THEN 
REWIND  LUHDYE 
ELSE 

GO  TO  99 
END  IF 

IFdFKP2.EQ.O)GO  TO  30 
Read  off  irrelevant  entries 
DO  20  1=1, IFKP2*26 
READ ( LUHDYE ,  * ) COEFF 
CONTINUE 

30  DO  60  N=1,NDIM 


Read  off  the  constant  and  trigonometric  coefficients 
for  the  Epstein-Fourier  equation 
READ (LUHDYE, * ) RDC (N) , HODC (N) , SIDC (N) , S2DC (N) 

DO  40  M=1,MDIM 

READ  (LUHDYE,  * )  RCOS  (M,  N)  ,  HOCOS  (M,  N)  ,  SICOS  (M,  N)  ,  S2COS  (M,  N) 
40  CONTINUE 

C 

DO  50  M=1,MDIM 

READ (LUHDYE, *) RSIN (M,N) , HOSIN (M,N) , SISIN (M,N)  ,  S2SIN(M,N) 
50  CONTINUE 

C 

60  CONTINUE 
C 

IKPCHK=IFKP2 

IREWCK=1 
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c 

CLOSE (LUHDYE) 

C 

99  RETURN 
END 
C 
C 

SUBROUTINE  ADDHDY (RDC, RCOS, RSIN, HODC, HOCOS, HOSIN, SIDC, 

1  SICOS,  SISIN, S2DC, S2COS, S2SIN, MDIM, NDIM, K, ALTIME, COLTDE, FLUX) 
C  Calculate  the  Hardy  average  value  for  the  given  point 
C 

DIMENSION  RDC (NDIM) , HODC (NDIM) , SIDC (NDIM) , S2DC (NDIM) , 

1  RCOS (MDIM, NDIM) , RSIN (MDIM, NDIM) , HOCOS (MDIM, NDIM) , 

2  HOSIN (MDIM, NDIM) , SICOS (MDIM, NDIM) , SISIN (MDIM, NDIM) , 

3  S2COS (MDIM, NDIM) ,S2SIN (MDIM,  NDIM) 

C 

X-90 . -ABS (COLTDE) *180. /3. 14159 
ALCT-12  .  +A7.TIME*12  .  /3 . 14159 
IF(ALCT.GT.24.)  ALCT=ALCT-24 . 

C 

C  Chec)c  to  see  if  the  Fourier  series  have  to  be  recalculated 
IF(TEST.EQ.ALCT)GO  TO  10 
C 

C  Determine  the  coefficients  for  the  Epstein  equation 
R*FSUM (RDC, RSIN, RCOS, ALCT, 6,2,K) 

H0=FSUM (HODC, HOSIN, HOCOS, ALCT, 6,2,K' 

S1-FSUM(S1DC, SISIN, SICOS, ALCT,  6,2,K) 

S2=FSUM(S2DC,S2SIN, S2COS,ALCT,  6,2,K) 

C 

C  Use  the  Epstein  equation  to  calculate  the  average  value 
10  FLUX-R+Sl* (X-HO) + (S2-S1) *ALOG( (1-S1/S2*EXP(X-H0) ) / (1-S1/S2) ) 

C  Set  the  equatorward  lower  limit  flux  value  at  6  and 

C  the  poleward  lower  limit  at  7. 

1F((FLUX.LT.6.) .AND. (X . LT . 70 . ) ) FLUX=6 . 

IF ( (FLUX. LT.7 . ) .AND  \.GT. 70. ) ) FLUX=7. 

C 

TEST-ALCT 

C 

RETURN 

END 

C 

C 

REAL  FUNCTION  FSUM (DC, BSTN, BCOS, ALCT, MDIM, NDIM, K) 

C  Determines  the  sum  of  a  Fourier  series 
C 

DIMENSION  BSIN (MD 'M, NDIM) , BCOS (MDIM, NDIM) , DC (NDIM) 

C 

FSUM=0. 

C 

DO  10  L*1,MDIM 

FSUM=FSUM+BSIN(L,K) *SIN (L*3 . 1 4 1 592*ALCT/12 . ) + 

1  BCOS (L,K) *COS (L*3.141592*ALCT/12. ) 

10  CONTINUE 
C 

FSUM=FSUM+DC (K) 

C 

RETURN 

END 

SUBROUTINE  WRT3D (LUN, IRECMX, ID, RID, CHID, ARRAY, IDIM, JDIM,KDIM, 
1  ITMDIM) 

C 

C  PROGRAMMER:  BOB  SPIRO  DATE:  6/26/88 

C 

C  PURPOSE:  THIS  SUBROUTINE  WRITES  3-D  ARRAYS  INTO  THE  STANDARD 
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MAGNETOSPHERIC  SPECIFICATIONS  MODEL  FILE  FORMAT. 

CHARACTER* 80  CHID 

DIMENSION  ID (20) ,RID (20) , ARRAY (IDIM, JDIM, KDIM) 

IRECL  =IDIM*JDIM  +  2*80 

OPEN  (UNIT=LUN, ACCESS=' DIRECT' , RECL=IRECL, STATUS=' UNKNOWN' ) 
ID(12)=KDIM 
WRITE  THE  ARRAY 

DO  10,  K=l,  KDIM 
CALCULATE  THE  RECORD  NUMBER 
ID(13)=K 

IREC  =  (IRECMX-1) *KDIM  +  K 
WRITE  (LUN, REC=IREC)  ID, RID, CHID, 

2  (  (ARRAYd,  J,K)  ,  1=1,  IDIM)  ,  J=l,  JDIM) 

10  CONTINUE 

CLOSE  (LUN) 

RETURN 

END 

SUBROUTINE  RDHDR (LUN, FILNAM, IRECMX, ID, RID, CHID, IDIM, JDIM, ITMDIM) 

PROGRAMMER:  BOB  SPIRO  DATE:  6/26/88 

PURPOSE:  THIS  ROUTINE  READS  THE  HEADER  OF  THE  STANDARD 
MAGNETOSPERIC  SPECIFICATIONS  MODEL  FILE  FORMAT. 

CHARACTER  CHID*80,  FILNAM*6 
DIMENSION  ID(20) ,RID(20) 

OPEN  THE  FILE 

IRECL  =  IDIM*JDIM  +  2*80 

OPEN  (UNIT=LUN, ACCESS=' DIRECT' , RECL=IRECL, STATUS=' OLD' ) 

READ  THE  HEADER 

READ  (LUN, REC= IRECMX)  ID, RID, CHID 
C 

CLOSE  (LUN) 

C 

RETURN 

END 

C 

SUBROUTINE  READ3D (LUN, FILNAM, LREC, IDIM,  JDIM,  KDIM,  ITMDIM,  ID,  RID, 

2  CHID, ARRAY) 

C 

C  PROGRAMMER:  BOB  SPIRO  DATE:  6/26/88 

C 

C  PURPOSE:  THIS  SUBROUTINE  READS  A  LOGICAL  RECORD  FROM  THE 

C  STANDARD  MAGNETOSPHERIC  SPECIFICATIONS  MODEL  FILE  FORMAT. 

C 

C 

CHARACTER  CHID*80,  FILNAM*e 
C 

DIMENSION  ARRAYdDIM,  JDIM,  KDIM) 

DIMENSION  IDi20) ,RID(20) 
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OPEN  THE  FILE 


IRECL  =  IDIM*JDIM  +  2*80 

OPEN  {UNIT=LUN, ACCESS=' DIRECT' , RECL=IRECL, STATUS*' OLD' ) 
READ  THE  ARRAY 


DO  10,  K=l,  KDIM 

CALCULATE  THE  RECORD  NUMBER 


IREC  =  (LREC-1) *KDIM  +  K 

READ  {LUN,REC=IREC)  ID, RID, CHID, 

2  ( (ARRAY (I, J, K) , 1=1, IDIM) , J=l, JDIM) 

10  CONTINUE 

C 

CLOSE (LUN) 

C 

RETURN 

END 

SUBROUTINE  SETALM (ALAM, lEMAX, lEDIM, IFLAV, ALMDEL) 

C 

C  THIS  SUBROUTINE  READS  THE  NUMBER  OF  ENERGY  CHANNELS  AND  THEIR 
C  ENERGIES  AT  GEOSYNCHRONOUS  ORBIT  AND  CALCULATES  THE  ENERGY 
C  INVARIANTS  NEEDED  TO  RUN  THE  PROGRAM. 

C  THE  INPUT  ENERGY  IS  IN  EV  AND  MUST  BE  IN  ASCENDING  ORDER  SO  THAT  THE 
C  ALMDEL  VARIABLES  CAN  BE  CORRECTLY  CALCULATED. 

C 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LIUDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LU2MIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
C 

PARAMETER (VM6=7 . 0 ) 

C 

DIMENSION  ALAM(IEDIM) 

DIMENSION  IFLAV (lEDIM) 

DIMENSION  ALMDEL (lEDIM) 

DIMENSION  NUM(3) 

C 

OPEN (UNIT=LUENCH, FILE*' ENCHAN' , STATUS*' OLD'  ) 

C 

READ (LUENCH, *) lEMAX 
IF (lEMAX.GT. lEDIM) THEN 

WRITE (6,*)'  NUMBER  OF  ENERGY  CHANNELS  GREATER  THAN  MAXIMUM' 

STOP 

ENDIF 

C 

DO  5  N=l, 3 
NUM(N) *0 
5  CONTINUE 
C 

DO  10  IE=1,IEMAX 

READ (LUENCH, *) IFLAV (IE) , ENCHNL 
ISP=IFLAV(IE) 

NUM(ISP) =NUM(ISP) +1 

ALAM (IE)*  ENCHNL/VM6 

IF(IFLAV(IE) .EQ. l)ALAM(IE) *-ALAM(IE) 

IF(NUM(ISP) .GT.l.AND. (ABS (ALAM(IE) ) .LT.ABS (ALAM(IE-l) ) ) ) THEN 
WRITE(6,*)'  ENERGY  CHANNELS  NOT  IN  INCREASING  ORDER' 

STOP 
ENDIF 
10  CONTINUE 
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MSM45460 

MSM45470 

MSM45480 

MSM45490 

MSM45500 

MSM45510 

MSM45520 

MSM45530 

MSM45540 

MSM45550 

MSM45560 

MSM45570 

MSM45580 

MSM45590 

MSM45600 

MSM45610 

MSM45620 

MSM45630 

MSM45640 

MSM45650 

MSM45660 

MSM45670 

MSM45680 

MSM45690 

MSM45700 

MSM45710 

MSM45720 

MSM45730 

MSM45740 

MSM45750 

MSM45760 

.■1SM45770 

MSM45780 

MSM45790 

MSM45800 

MSM45810 

MSM45820 

MSM45830 

MSM45840 

MSM45850 

MSM45860 

MSM45870 

MSM45880 

MSM45890 

MSM45900 

RSM45910 

MSM45920 

MSM45930 

MSM45940 

MSM45950 

MSM45960 

MSM45970 

MSM45980 

MSM45990 

MSM46000 

MSM46010 

MSM46020 

MSM46030 

MSM46040 

MSM46050 

MSM46060 

MSM46070 


o  o  o  o  o  o  o 


90/06/30 

ia:03;44 


msml.for 


COMPUTE  ALMDEL 

DO  20  IE=1,IEMAX 
ISP=IFLAV(IE) 

IF(NUM(ISP) .GE.2)  THEN 

IF(IE.EQ.1.0R.IFLAV(IE-1) .NE.ISP)  THEN 
ALMMIN=0 . 

ELSE 

ALMMIN= (ALAM(IE-1)+ALAM(IE) ) 12. 

END  IF 

IF(IE.EQ.IEMAX.OR.IFLAV(IE+l) .NE.ISP)  THEN 
ALMMAX=1 . 5*ALAM (IE) - . 5*ALAM <IE-1) 

ELSE 

ALMMAX=(ALAM(IE)+ALAM(IE+1) ) 12. 

END  IF 

ALMDEL (IE) =ABS (ALMMAX) -ABS (ALMMIN) 

END  IF 
20  CONTINUE 


WRITE (6,  997) 

FORMAT (IHl, 'K  ALAM(K)  ALMDEL (K)') 

DO  30  K=1,IEMAX 

WRITE(6,996)  K,ALAM(K) , ALMDEL (K) 

FORMATdH  ,I3,2F15.4) 

CONTINUE 
CLOSE (LUENCH) 

RETURN 

END 

SUBROUTINE  BNDSET (LATDIM, LTDIM, lEDIM, ITMDIM, ITMMAX, 

L  IRDIM, NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXR, FLXNRG, FLXKP, FLXMAT, 

!  NAUGEL, TIMTAG, BNDLOC, IFLAV, AUGPAR, R, P, VM, ETA, ETABND, 

5  FLXBND, ALAM, ALMDEL, lEMAX) 


VERSION;  1.00  DATE:  09.02.89 

05.08.90 

PURPOSE:  SUBROUTINE  TO  COMPUTE  BNDY  PLASMA  DISTRIBUTION  BASED  ON 
STATISTICAL  (KP-BASED)  DATA.  THE 
GENERAL  SCHEME  IS  DESCRIBED  IN  SECTION  2.5.5  OF 
CONTRACT  #F19c,I8-87-K-0001  FINAL  REPORT. 


INPUT: 


LATDIM 

LTDIM 

lEDIM 

ITMDIM 

ITMMAX 

IRDIM 

NRGDIM 

KPDIM 

KPPLUS 

ISPDIM 

FLXR 

FLXNRG 

FLXKP 


NUMBER  OF  LATITUDINAL  GRID  PTS 

NUMBER  OF  LOCAL  TIME  GRID  POINTS  (INCL  WRAP) 

NUMBER  OF  ENERGY  SPECIES 

MAX  NUMBER  OF  TEMPORAL  GRID  PTS 

ACTUAL-  NUMBER 

THIS  FUN 

NUMBER  OF  R  BINS  IN  FLXMAT  ARRAY 

NUMBER  OF  LOGARITHMICALLY  SPACE  ENERGY  BINS 

IN  FLXMAT  ARRAY 

NUMBER  OF  KP  BINS  IN  FLXMAT  ARRAY 
AUGMENTED  KP  DIMENSION  OF  FLXMAT  (KPDIM+2) 
NUMBER  OF  MASS  SPECIES  IN  FLXMAT  ARRAY 
LOG(R)  VALUES  FOR  WHICH  FLXMAT  IS  COMPUTED  (RE) 
LOG  OF  ENERGY  VALUES  FOR  WHICH  FLXMAT  IS 
COMPUTED  (LOGIC (EV)) 

KP  VALUES  FOR  WHICH  FLXMAT  IS  COMPUTED 


MSM46080 

MSM46090 

MSM46100 

MSM46110 

MSM46120 

MSM46130 

MSM46140 

MSM46150 

MSM46160 

MSM46170 

MSM46180 

MSM46190 

MSM46200 

MSM46210 

MSM46220 

MSM46230 

MSM46240 

MSM46250 

MSM46260 

MSM46270 

MSM46280 

MSM46290 

MSM46300 

MSM46310 

MSM46320 

MSM46330 

MSM46340 

MSM46350 

MSM46360 

MSM46370 

MSM46380 

MSM46390 

MSM46400 

MSM46410 

MSM46420 

MSM46430 

MSM46440 

MSM46450 

MSM46460 

MSM46470 

MSM46480 

MSM46490 

MSM46500 

MSM46510 

MSM46520 

MSM46530 

MSM46540 

MSM46550 

MSM46560 

MSM46570 

MSM46580 

MSM46590 

MSM46600 

MSM46610 

MSM46620 

MSM46630 

MSM46640 

MSM46650 

MSM46660 

MSM46670 

MSM46680 

MSM46690 

MSM46700 

MSM46710 


FLXMAT 


NAUGEL 

TIMTAG 

END  LOG 
IFLAV 


AUGPAR 

R 

P 

VM 

ETA 

AliAM 

ALMDEL 

lEMAX 


msml.for 

ARRAY  OF  KP-DEPENDENT  LOG (FLUX)  VALUES 

AS  FCN  OF  R  AND  ENERGY  (LOGIC (PARTICLES/CM* *2/ 

S/SR/EV) ) 

DIMENSION  OF  AUGMENTED  PARRAY,  AUGPAR 

STRING  GIVING  TIMES  FOR  WHICH  E  AND  B  FIELD 

VALUES  ARE  CALCULATED 

ARRAY  GIVING  BNDY  LOCATIONS 

STRING  THAT  GIVES  WHAT  KIND  OF  PARTICLE 

IFLAV=1  FOR  ELECTRONS,  IFLAV=2  FOR  H+, 

IFLAV=3  FOR  0+  IONS 
AUGMENTED  PARAMETER  ARRAY 
RADIAL  DISTANCE  TO  BMIN  PT  (RE) 

HOUR  ANGLE  MEASURED  EASTWARD  FROM  NOON  IN  X-Y 
PLANE  OF  MAGNETOSPHERE  (RADIANS) 

(FLUX  TUBE  VOLUME) **-2/3  (RE/NT) **-2/3 
INVARIANT  DENSITY  ARRAY 
STRING  GIVING  ENERGY  INVARIANTS 
STRING  GIVING  ENERGY  INVARIANT  INTERVALS 
NUMBER  OF  ENERGY  SPECIES  FOR  RUN 


OUTPUT : 


ETABND 

FLXBND 


BOUNDARY  ETA  DISTRIBUTION 
BOUNDARY  FLUX  VALUES 


PROGRAMMER:  R,W.  SPIRO 


COMMON  /IRDREC/  IRECPT, IRECEB, IRDBEG 

INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC,  KP,  DST, DDST, 

L  EQEDGE,DLATAZ,DLATRV,MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND,PCP,DEQDT, IPATT 

COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP,DST, 
L  E(3EDGE,  DLATAZ,  DLATRV,  MLTRV,  IMFBX,  IMFBY,  IMFBZ,  CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND, PCP, IPATT, DDST, DEQDT 


DIMENSION  VM (LATDIM, LTDIM, ITMDIM) , ETA (LATDIM, LTDIM, lEDIM) 
DIMENSION  R (LATDIM, LTDIM, ITMDIM) , P (LATDIM, LTDIM, ITMDIM) 
DIMENSION  BNDLOC (LTDIM, ITMDIM) , TIMTAG (ITMDIM) , IFLAV (lEDIM) 
DIMENSION  ETABND (LTDIM, lEDIM, ITMDIM) ,ALAM(IEDIM) , ALMDEL ( lEDIM) 
DIMENSION  FLXBND (LTDIM, lEDIM, ITMDIM) 

DIMENSION  AUGPAR (NAUGEL, ITMDIM) 

DIMENSION  FLXMAT (IRDIM,NRGDIM,KPPLUS, ISPDIM) 

DIMENSION  FLXR(IRDIM) , FLXNRG (NRGDIM) , FLXKP (KPDIM) 

DATA  VM13  /2.182/ 

PI=ATAN2(0.,-1.) 

WRITE (6,*)  'IN  BNDSET' 

MAIN  DO  LOOPS 


ITBEG-1 


MSM46720 

MSM46730 

MSM46740 

MSM46750 

MSM46760 

MSM46770 

MSM46780 

MSM46790 

MSM46800 

MSM46810 

MSM46820 

MSM46830 

MSM46840 

MSM46850 

MSM46860 

MSM46870 

MSM46880 

MSM46890 

MSM46900 

MSM46910 

MSM46920 

MSM46930 

MSM46940 

MSM46950 

MSM46960 

MSM46970 

MSM46980 

MSM46990 

MSM47000 

MSM47010 

MSM47020 

MSM47030 

MSM47040 

MSM47050 

MSM47060 

MSM47070 

MSM47080 

MSM47090 

MSM47100 

MSM47110 

MSM47120 

MSM47130 

MSM47140 

MSM47150 

MSM47160 

MSM47170 

MSM47180 

MSM47190 

MSM4720C 

MSM47210 

MSM47220 

MSM47230 

MSM47240 

MSM47250 

MSM47260 

MSM47270 

MSM47280 

MSM47290 

MSM47300 

MSM47310 

MSM47320 

MSM47330 

MSM47340 

MSM47350 


no  non  ooooo  oooooo  noon  no  o  on  no 


msml.for 


ITEND=ITMMAX 

VMBND=VM13 

RBND-13. 

PBND=PI 

LOOP  OVER  TIME  LABELS 
DO  5  IT=ITBEG, ITEND 

LOOP  OVER  LOCAL  TIME  COORDINATE 
DO  10  J=2,LTDIM-2 

BI=BNDLOC(J,IT) 

BJ=J 

BT=IT 

LOOP  OVER  ENERGY  SPECIES 
DO  20  K=1,IEMAX 
ISP=IFLAV(K) 

IF(IFLAV(K) .EQ.2)  ATOMWT=l . 
IF(IFLAV(K) .EQ.3)  ATOMWT=16. 


DEBUG  590 


FKP=AUGPAR(KP,  IT) 

ENRG=VMBND*ABS (ALAM (K) ) 

IF (J. EQ.2)  THEN 

WRITE (6, *) ' IT, ISP,FKP,RBND,PBND,ENRG' ,IT, ISP, FKP, RBND, 
PBND,ENRG 

END  IF 

FLUX=FLXVAL (ISP, FKP, RBND, PBND, ENRG, IRDIM, 

NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXMAT, FLXR, 

FLXNRG, FLXKP) 


FLXBND ( J, K, IT) =FLUX 


CONVERT  FLUX  TO  INVARIANT  DENSITY 


IF (ALAM(K) . LT. 0 . )  THEN 

ETABND ( J, K, IT) =FLUX*ALMDEL (K) /7 . 392E-16/ 

SQRT (ABS (ALAM (K) ) ) /VMBND 

ELSE 

ETABND  < J, K, IT) =FLUX*ALMDEL (K) *SQRT (ATOMWT) /I . 731E-17/ 

SQRT (ABS (ALAM (K) ) ) /VMBND 

END  IF 


20  CONTINUE 
10  CONTINUE 

DO  15  K-1,IEMAX 

ETABND (1, K, IT) =ETABND (LTDIM-3, K, IT) 
ETABND (LTDIM-1 , K, IT) =ETABND (2, K,  IT) 
ETABND (LTDIM, K, IT) =ETABND (3,K, IT) 
FLXBND (1, K, IT) -FLXBND (LTDIM-3, K, IT) 
FLXBND (LTDIM-1, K, IT) -FLXBND (2,  K,  IT) 


MSM47360 

MSM47370 

MSM47380 

MSM47390 

MSM47400 

MSM47410 

MSM47420 

MSM47430 

MSM47440 

MSM47450 

MSM47460 

MSM47470 

MSM47480 

MSM47490 

MSM47500 

MSM47510 

MSM47520 

MSM47530 

MSM47540 

MSM47550 

MSM47560 

MSM47570 

MSM47580 

MSM47590 

MSM47600 

MSM47610 

MSM47620 

MSM47630 

MSM47640 

MSM47650 

MSM47660 

MSM47670 

MSM47680 

MSM47690 

MSM47700 

MSM47710 

MSM47720 

MSM47730 

MSM47740 

MSM47750 

MSM47760 

MSM47770 

MSM47780 

MSM47790 

MSM47800 

MSM47810 

MSM47820 

MSM47830 

MSM47840 

MSM47850 

MSM47860 

MSM47870 

MSM47880 

MSM47890 

MSM47900 

MSM47910 

MSM47920 

MSM47930 

MSM47940 

MSM47950 

MSM47960 

MSM47970 

MSM47980 

MSM47990 


oo  on  n  on  ooooooooooooo  oooo  oo 


msml.for 


FLXBND  (LTDIM,  K,  IT)  =FLXBND  (3,  K,  IT) 
15  CONTINUE 

5  CONTINUE 


RETURN 

END 

FUNCTION  CFACT (IDIM, JDIM, lEDIM, lUSE, JUSE, lEUSE, ETAEQK, ALAM, 

2  PWR, ETA,ALAME) 

FUNCTION  SUBPROGRAM  TO  CALCULAT  CORRECTION  FACTOR  BASED  ON 
EQUILIBRIUM  ETA  VALUE. 

CFACT= (1 . -ETAEQK/ETA) 

RETURN 

END 

SUBROUTINE  SETSCT (L, ISEC, lEDIM, LTDIM, ITMDIM, LATDIM, FKP, ALAM, 
2  ALOCT, SCTFRC, lEMAX) 

VERSION  2.00  DATE:  09.11.89 

PURPOSE: 

SUBROUTINE  TO  COMPUTE  SPECIES-DEPENDENT  PITCH 
ANGLE  SCATTERING  EFFICIENCY  SCTFRC (IE, J, L) . 

PROGRAMMER:  R.W.  SPIRO 

REF:  SECTION  2.6.3  OF  THE  FINAL  REPORT  FOR 

CONTRACT  #F19628-87-K-0001 


DIMENSION  SCTFRC (lEDIM, LTDIM, ITMDIM) 
DIMENSION  ALOCT (LATDIM. LTDIM) ,ALAM(IEDIM) 


PI=ATAN2(0.,-1.) 

LOOP  OVER  ALL  LOCAL  TIME  GRID  LINES 
DO  10  J-1, LTDIM 


LOOP  OVER  ALL  ENERGY  SPECIES 
DO  20  IE=1,IEMAX 

IF(ALAM(IE) .LT.3000. )  THEN 


C 

C 

2 

2 

C 


USE  KP  DEPENDENT  FORM,  INDEPENDENT  OF  LOCAL  TIME 
IF (FKP. LE. 1.5)  THEN 
SCTFRC (IE, J,L)=. 333 

ELSE  IF (FKP. GT. 1.5. AND. FKP. LE. 2. 5)  THEN 

SCTFRC (IE,J,L)=. 333* (2 . 5-FKP) + . 667* (FKP-1.5) 

ELSE 

SCTFRCdE,  J,L)  =  .667 
END  IF 

ELSE 

USE  LOCAL  TIME  DEPENDENT  FORM,  INDEPENDENT  OF  KP 
IF (ALOCT ( LATDIM, J) .GE.PI/2. . AND . ALOCT (LATDIM, J) . LE . 
3.*PI/2.)  THEN 

SCTFRCdE,  J,L)=0.1/SQRT(ABS(ALAM(IE)  )  /3000.) 

ELSE 

SCTFRCdE,  J,L)  =  (0.1  +  0. 9*COS  (ALOCT  (LATDIM,  J)  )  )  / 
SQRT(ABS(ALAM(IE) ) /3000. ) 

END  IF 
END  IF 


MSM48000 

MSM48010 

MSM48020 

MSM48030 

MSM48040 

MSM48050 

MSM48060 

MSM48070 

MSM48080 

MSM48090 

MSM48100 

MSM48110 

MSM48120 

MSM48130 

MSM48140 

MSM48150 

MSM48160 

MSM48170 

MSM48180 

MSM48190 

MSM48200 

MSM48210 

MSM48220 

MSM48230 

MSM48240 

MSM48250 

MSM48260 

MSM48270 

MSM48280 

MSM48290 

MSM48300 

MSM48310 

MSM48320 

MSM48330 

MSM48340 

MSM48350 

MSM48360 

MSM48370 

MSM48380 

MSM48390 

MSM48400 

MSM48410 

MSM48420 

MSM48430 

MSM48440 

MSM48450 

MSM48460 

MSM48470 

MSM48480 

MSM48490 

MSM48500 

MSM48510 

MSM48520 

MSM48530 

MSM48540 

MSM48550 

MSM48560 

MSM48570 

MSM48580 

MSM48590 

MSM48600 

MSM48610 

MSM48620 

MSM48630 


ooo  o  o  oooooooooo  oo 


msml.for 


c 

20  CONTINUE 
10  CONTINUE 


RETURN 

END 

SUBROUTINE  PFIX (PI, P2, P3, P4, P5) 

PURPOSE:  SUBROUTINE  TO  ADJUST  MODULUS  OF  P2  AND  P3  TO  MATCH  PI. 

ON  OUTPUT  P4  CORRESPONDS  TO  P2,  P5  TO  P3 

VERSION  1.00  DATE:  09.04.89 

PROGRAMMER:  R.W.  SPIRO 


PI=ATAN2(0.,-1.) 


P4=P2 

P5=P3 

IF(ABS (P2-P3) .GT.PI)  THEN 
IF(P2.LT.P3)  THEN 
P4=P2+2 . *PI 
ELSE 

P5=P3+2.*PI 
END  IF 

IF(Pl.LT.PI)  THEN 
P4*P4-2.*PI 
P5=P5-2. *PI 
END  IF 

END  IF 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 


RETURN 

END 

SUBROUTINE  INITAL (LL, LATDIM, LTDIM, lEDIM, ITMDIM, IRDIM, 

2  NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXR, FLXNRG, FLXKP, 

3  FLXMAT, IFLAV,FKP,R,P,VM,ETA,ETABEG,ALAM,ALMDEL, 

4  BNDLOC,AZERO, BZERO, 

5  CZERO, lEMAX) 


VERSION:  1.00  DATE;  10.10.89 

PURPOSE:  SUBROUTINE  TO  COMPUTE  INITIAL  PLASMA  DISTRIBUTION  BASED  ON 
EITHER  STATISTICAL  (KP-BASED)  DATA  OR  RESULTS 
FROM  PREVIOUS  RUNS.  THE  GENERAL  SCHEME  IS  DESCRIBED  IN 
SECTION  2.5.4  OF  THE  FINAL  REPORT  FOR 
CONTRACT  #F19628-87-K-0001 


INPUT: 

LL  TEMPORAL  GRID  INDEX 

LATDIM  NUMBER  OF  LATITUDINAL  GRID  PTS 

LTDIM  NUMBER  OF  LOCAL  TIME  GRID  POINTS  (INCL  WRAP) 

lEDIM  MAX  NUMBER  OF  ENERGY  SPECIES 

ITMDIM  MAX  NUMBER  OF  TEMPORAL  GRID  PTS 

IRDIM  R  DEPTH  IN  FLXMAT  ARRAY 

NRGDIM  ENERGY  DEPTH  IN  FLXMAT  ARRAY 

KPDIM  KP  DEPTH  IN  FLXMAT  ARRAY 

KPPLUS  AUGMENTED  KP  DIMENSION  OF  FLXMAT  (KPDIM+2) 


MSM48640 

MSM48650 

MSM48660 

MSM48670 

MSM48680 

MSM48690 

MSM48700 

MSM48710 

MSM48720 

MSM48730 

MSM48740 

MSM48750 

MSM48760 

MSM48770 

MSM48780 

MSM48790 

MSM48800 

MSM48810 

MSM48820 

MSM48830 

MSM48840 

MSM48850 

MSM48860 

MSM48870 

MSM48880 

MSM48890 

MSM48900 

MSM48910 

MSM48920 

MSM48930 

MSM48940 

MSM48950 

MSM48960 

MSM48970 

MSM48980 

MSM48990 

MSM49000 

MSM49010 

MSM49020 

MSM49030 

MSM49040 

MSM49050 

MSM49060 

MSM49070 

MSM49080 

MSM49090 

MSM49100 

MSM49110 

MSM49120 

MSM49130 

MSM49140 

MSM49150 

MSM49160 

MSM49170 

MSM49180 

MSM49190 

MSM49200 

MSM49210 

MSM49220 

MSM49230 

MSM49240 

MSM49250 

MSM49260 

MSM49270 


ooooo  o  oo 


9^ 


ISPDIM 

FLXR 

FLXNRG 

FLXKP 

FLXMAT 

IFLAV 


VM 

ETA 

ALAM 

ALMOEL 

BNDLOC 

AZERO 

BZERO 

CZERO 

lEMAX 


msml.for 

NUMBER  OF  MASS  SPECIES 

ALOGIO(R)  VALUES  FOR  WHICH  FLXMAT  ARRAY  IS 
CALCULATED 

ALOGIO (ENERGY)  VALUES  FOR  WHICH  FLXMAT  ARRAY  IS 
CALCULATED 

KP  VALUES  FOR  WHICH  FLXMAT  ARRAY  IS  CALCULATED 
ALOGIO (FLUX)  FOR  A  GIVEN  R, ENERGY,  AND  KP 
STRING  THAT  GIVES  WHAT  KIND  OF  PARTICLE 
IFLAV=1  FOR  ELECTRONS,  IFLAV=2  FOR  H+, 

IFLAV=3  FOR  0+  IONS 

FLOATING  PT  KP  VALUE 

RADIAL  DISTANCE  TO  BMIN  PT  (RE) 

HOUR  ANGLE  MEASURED  EASTWARD  FROM  NOON  IN  X-Y 
PLANE  OF  MAGNETOSPHERE  (RADIANS) 

(FLUX  TUBE  VOLUME) **-2/3  (RE/NT) **-2/3 
INVARIANT  DENSITY  ARRAY 
STRING  GIVING  ENERGY  INVARIANTS 
STRING  GIVING  ENERGY  INVARIANT  INTERVALS 
ARRAY  GIVING  BNDY  LOCATIONS 
STATISTICAL  MODEL  WEIGHTING  PARAMETER 
OLD  RESULTS  WEIGHTING  PARAMETER 
TRACEBACK  WEIGHTING  PARAMETER 
NUMBER  OF  PARTICLE  SPECIES  USED 


WEIGHTING  PARAMETERS  SET  IN  DATA  STATEMENTS 

GRZERO  PARAMETER  TO  SPECIFY  R  GAUSSIAN  WIDTH 

GPZERO  PARAMETER  TO  SPECIFY  P  GAUSSIAN  WIDTH 

GLZERO  PARAMETER  TO  SPECIFY  ALAM  GAUSSIAN  WIDTH 


OUTPUT : 

ETABEG 


INITIAL  ETA  DISTRIBUTION 


PROGRAMMER:  R.W.  SPIRO 


COMMON  /IRDREC/  IRECPT, IRECEB, IRDBEG 


DIMENSION  VM (LATDIM, LTDIM, ITMDIM) , ETA (LATDIM, LTDIM, lEDIM) 
DIMENSION  R (LATDIM, LTDIM, ITMDIM) , P (LATDIM, LTDIM, ITMDIM) 
DIMENSION  IFLAV (lEDIM) 

DIMENSION  ETABEG (LATDIM, L "DIM, lEDIM) ,ALAM(IEDIM) , ALMDEL (lEDIM) 
DIMENSION  BNDLOC (LTDIM, ITMDIM) 

DIMENSION  FLXMAT (IRDIM, NRGDIM, KPPLUS,  ISPDIM) 

DIMENSION  FLXR (IRDIM) , FLXNRG (NRGDIM) , FLXKP (KPDIM) 

DATA  GRZERO/ . 05/, GPZERO/ . 05  /  ,  GLZERO/ . 3/ 


PI»ATAN2 (0. , -1 . ) 

INITIALIZE  ETABEG  ARRAY 
DO  2  K-1,IEMAX 
DO  4  J*l, LTDIM 

DO  6  I-l, LATDIM 

ETABEG (I, J,K)*0. 
6  CONTINUE 


MSM49280 

MSM49290 

MSM49300 

MSM49310 

MSM49320 

MSM49330 

MSM49340 

MSM49350 

MSM49360 

MSM49370 

MSM49380 

MSM49390 

MSM49400 

MSM49410 

MSM49420 

MSM49430 

MSM49440 

MSM49450 

MSM49460 

MSM49470 

MSM49480 

MSM49490 

MSM49500 

MSM49510 

MSM49520 

MSM49530 

MSM49540 

MSM49550 

MSM49560 

MSM49570 

MSM49580 

MSM49590 

MSM49600 

MSM49610 

MSM49620 

MSM49630 

MSM49640 

MSM49650 

MSM49660 

MSM49670 

M5M49680 

MSM49690 

MSM49700 

MSM49710 

MSM49720 

MSM49730 

MSM49740 

MSM49750 

MSM49760 

MSM49770 

MSM49780 

MSM49790 

MSM49800 

MSM49810 

MSM49820 

MSM49830 

MSM49840 

MSM49850 

MSM49860 

MSM49870 

MSM49880 

MSM49890 

MSM49900 

MSM49910 


no  noon  noon  ooono  o  noon  non 


msml.for 


4  CONTINUE 
2  CONTINUE 


MAIN  DO  LOOPS 


DO  10  K=1,IEMAX 
ISP-IFLAV(K) 

IF(IFLAV(K) .EQ.2)  ATOMWT=l . 
IF(IFLAV(K) .EQ.3)  ATOMWT=16. 

DO  20  J»1,LTDIM 

IBEG=BNDLOC ( J,  LL) 

DO  30  I=IBEG, LATDIM 
SUM1=0 . 

SUM2=0 . 

ENRG=ABS (ALAM(K) ) *VM(I, J,LL) 


PREVIOUS  RESULT  COMPONENT  OF  SUM 

IF(ETA(I, J,K) .GT.O.)  THEN 
IF(ALAM(K) .LT.O. )  THEN 

FLX0LD=7.392E-16*SQRT(ABS(ALAM(K) ) ) *VM(I, J,LL) * 

2  ETA(I, J,K) /ALMDEL(K) 

ELSE 

FLX0LD=1.731E-17*SQRT(ABS(ALAM(K) ) )*VM(I, J, LL)* 
2  ETA(I, J,K) /SQRT(ATOMWT) /ALMDEL(K) 

END  IF 

SUMl-SUMl+BZERO 

SUM2=SUM2+BZERO*FLXOLD 

END  IF 


STATISTICAL  (KP-BASED)  MODEL  COMPONENT  OF  SUM 
SUM1=SUM1+AZER0 

SUM2=SUM2+AZER0*FLXVAL(ISP,FKP,R(I, J, LL) ,P (I, J,LL) ,ENRG, 

2  IRDIM, NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXMAT, FLXR, 

3  FLXNRG,FLXKP) 


CALCULATE  DIFFERENTIAL  FLUX 

IF(SUM1.GT.0. )  THEN 
FLUX=SUM2/SUM1 
ELSE 

FLUX=0 . 

END  IF 


CONVERT  FLUX  TO  INVARIANT  DENSITY 

IF(ALAM(K) .LT.O.)  THEN 

ETABEG (I, J, K) =FLUX*ALMDEL (K) /7 . 392E-16/ 

2  SQRT(ABS(ALAM(K) ) ) /VM(I, J,LL) 

ELSE 

ETABEG (I, J, K) =FLUX*ALMDEL (K) *SQRT (ATOMWT) /I . 731E-17/ 
2  SQRT(ABS(ALAM(K) ) ) /VM(I, J,LL) 

END  IF 


30  CONTINUE 

C 


MSM49920 

MSM49930 

MSM49940 

MSM49950 

MSM49960 

MSM49970 

MSM49980 

MSM49990 

MSM50000 

MSM50010 

MSM50020 

MSM50030 

MSM50040 

MSM50050 

MSM50060 

MSM50070 

MSM50080 

MSM50090 

MSM50100 

MSM50110 

MSM50120 

MSM50130 

MSM50140 

MSM50150 

MSM50160 

MSM50170 

MSM50180 

MSM50190 

MSM50200 

MSM50210 

MSM5022d 

MSM50230 

MSM50240 

MSM50250 

MSM50260 

MSM50270 

MSM50280 

MSM50290 

MSM50300 

MSM50310 

MSM50320 

MSM50330 

MSM50340 

MSM50350 

MSM50360 

MSM50370 

MSM50380 

MSM50390 

MSM50400 

MSM50410 

MSM50420 

MSM50430 

MSM50440 

MSM50450 

MSM50460 

MSM50470 

MSM50480 

MSM50490 

MSM50500 

MSM50510 

MSM50520 

MSM50530 

MSM50540 

MSM50550 


oooo  ono  ooo  an  ooo  o  ooooooooo  oo  oo 


msmi.for 

DO  32  I=1,IBEG-1 

ETABEG (I, J, K) =ETABEG {IBEG,  J,  K) 
CONTINUE 


CONTINUE 


10  CONTINUE 


RETURN 

END 

SUBROUTINE  TIMINC (ITIME, ITMNEW, IINC) 


VERSION  2.00 


DATE:  09.06.89 


PURPOSE:  INCREMENT  TIME  FOR  NEXT  E  AND  B  FIELD  RECORD 


PROGRAMMER: 


SPIRO 


INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP, DST, DDST, 

L  EQEDGE,DLATAZ,DLATRV,MLTRV,IMFBX,IMFBY, IMFBZ, CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND,PCP,DEQDT, IPATT 

COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP,DST, 
L  EQEDGE,DLATAZ,DLATRV,MLTRV,IMFBX,IMFBY, IMFBZ, CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND, PCP, IPATT,  DDST, DEQDT 

DIMENSION  ITIME (3) , ITMNEW (3) , IINC (3) 


ITMNEW (lYEAR) =ITIME (lYEAR) 

ITMNEW (IDAY) =ITIME (IDAY) 

I TMNEW ( I SECND ) =I T IME ( I SECND ) + I I NC ( I SECND ) 

IF(ITMNEW(ISECND) .GE. 86400)  THEN 

ITMNEW (ISECND) =MOD (ITMNEW (ISECND)  ,  86400) 
ITMNEW (IDAY) = I TMNEW ( IDAY) +1 


CHANGE  BEFORE  THE  YEAR  2100  ****** 


MSM50560 

MSM50570 

MSM50580 

MSM50590 

MSM50600 

MSM50610 

MSM50620 

MSM50630 

MSM50640 

MSM50650 

MSM50660 

MSM50670 

MSM50680 

MSM50690 

MSM50700 

MSM50710 

MSM50720 

MSM50730 

MSM50740 

MSM50750 

MSM50760 

MSM50770 

MSM50780 

MSM50790 

MSM50800 

MSM50810 

MSM50820 

MSM50830 

MSM50840 

MSM50850 

MSM50860 

MSM50870 

MSM50880 

MSM50890 

MSM50900 

MSM50910 

MSM50920 

MSM50930 

MSM50940 

MSM50950 

MSM50960 

MSM50970 

MSM50980 

MSM50990 

MSM51000 

MSM51010 

MSM51020 

MSM51030 


IF  (ITMNEW(IDAY) .GT.365.AND.M0D(ITIME(IYEAR) ,4) .NE.O)  THEN  MSM51010 

ITMNEW(IDAY)  =  MOD (ITMNEW (IDAY) , 365)  MSM51020 

ITMNEW (lYEAR)  =  ITMNEW (lYEAR)  +  1  MSM51030 

ELSEI F ( I TMNEW ( I DAY )  . GT . 3  6  6 . AND . MOD ( I T I ME ( I YEAR) , 4 )  . EQ . 0 ) THENMSM5 1040 
ITMNEW(IDAY)  =  MOD ( ITMNEW ( IDAY)  ,  366 )  MSM51050 

ITMNEW (lYEAR)  =  ITMNEW (lYEAR)  +  1  MSM51060 

ENDIF  MSM51070 

MSM51080 

END  IF  MSM51090 

MSM51100 

MSM51110 

RETURN  MSM51120 

END  MSM51130 

MSM51140 

MSM51150 

MSM51160 

MSM51170 

SUBROUTINE  SETREF (LATDIM, LTDIM, lEDIM, ITMDIM, ITMMAX,  MSM51180 

2  IRDIM,NRGDIM,KPDIM,KPPLUS,ISPDIM,TIMTAG,TVAL,IFLAV,  MSM51190 


RETURN 

END 


non 


VERSION  2.00 


msml.for 

VM, R, P, BNDLOC, ALAM, ALMDEL, FLXMAT, FLXR, FLXNRG, 
FLXKP, FLXREF, lEMAX) 

DATE:  10.10.89 
05.08.90 


PURPOSE: 

SUBROUTINE  TO  SET  UPPER  LIMIT  REFERENCE  FLUX  FOR  TIME  TVAL 
PROGRAMMER:  R.W.  SPIRO 

REF:  SECTION  2.5.6  OF  THE  FINAL  REPORT  FOR 

CONTRACT  #F19628-87-K-0001 


LATDIM 

LTDIM 

lEDIM 

ITMDIM 

ITMMAX 

IRDIM 

NRGDIM 

KPDIM 

KPPLUS 

ISPDIM 

TIMTAG 

TVAL 

IFLAV 


BNDLOC 

ALAM 

ALMDEL 

FLXMAT 

FLXR 

FLXNRG 

FLXKP 

lEMAX 


OUTPUT : 

FLXREF 


NUMBER  Oi  LATITUDINAL  GRID  SPACES 

NUMBER  OF  LOCAL  TIME  (LONGITUDINAL)  GRID  SPACES 

MAXIMUM  NUMBER  OF  ENERGY  SPECIES 

MAXIMUM  NUMBER  OF  TEMPORAL  STEPS 

ACTUAL  NUMBER  OF  TEMPORAL  STEPS  FOR  THIS  RUN 

R  DIMENSION  OF  FLXMAT  ARRAYS 

ENERGY  DIMENSION  OF  FLXMAT  ARRAYS 

KP  DIMENSION  OF  FLXMAT  ARRAYS 

KP  DIMENSION  OF  AUGMENTED  FLXMAT  ARRAYS 

(KPPLUS=KPDIM+2) 

PLASMA  MASS  SPECIES  DIMENSION 

VECTOR  GIVING  TIME  AT  WHICH  E  AND  B  FIELD  PARAMETERS 
ARE  COMPUTED  (SECONDS) 

CURRENT  TIME  (SECONDS) 

MASS  SPECIES  FOR  A  GIVEN  PARTICLE  ENERGY  SPECIES 
l=ELECTRONS,  2=H+  IONS,  3=0+  IONS 
(FLUX  TUBE  VOLUME) ** (-2/3) 

ARRAY  GIVING  RADIAL  DISTANCE  OF  GRID  POINTS  IN 
MAGNETOSPHERIC  EQUATORIAL  PLANE  (RE) 

LOCAL  TIME  HOUR  ANGLE  MEASURED  EASTWARD  FROM  NOON 
OF  GRID  PTS  IN  MAGNETOSPHERIC  EQUATORIAL  PLANE 
(RADIANS) 

LOCATION  OF  OUTER  BOUNDARY  OF  DETAILED  MODEL 
ENERGY  INVARIANT  VECTOR  (EV  (RE/NT) **2/3) 

WIDTH  OF  ENERGY  INVARIANT  CHANNELS 

ARRAY  OF  EMPIRICAL  FLUXES  AS  FUNCTION  OF  R,  ENERGY, 
AND  KP 

R  VALUES  AT  WHICH  FLXMAT  IS  CALCULATED 
ENERGY  VALUES  AT  WHICH  FLXMAT  IS  CALCULATED 
KP  VALUES  AT  WHICH  FLXMAT  IS  CALCULATED 
ACTUAL  NUMBER  OF  ENERGY  CHANNELS  USED 


UPPER  LIMIT  REFERENCE  FLUX  (LOG (# /CM* *2 


DIMENSION  TIMTAG (ITMDIM) ,ALAM(IEDIM) , ALMDEL (lEDIM) 
DIMENSION  VM (LATDIM, LTDIM, ITMDIM) , R (LATDIM, LTDIM, ITMDIM) 
DIMENSION  P (LATDIM, LTDIM, ITMDIM) , FLXREF (LATDIM, LTDIM, lEDIM) 
DIMENSION  IFLAV (lEDIM) 

DIMENSION  BNDLOC (LTDIM, ITMDIM) 

DIMENSION  FLXMAT (IRDIM, NRGDIM, KPPLUS,  ISPDIM) 

DIMENSION  FLXR (IRDIM) , FLXNRG (NRGDIM) , FLXKP (KPDIM) 


CALCULATE  NORMALIZED  TIME  BT 

BT»TNORML (TVAL, TIMTAG, ITMDIM) 

ITT“BT 

FT*REAL(ITT) 


MSM51200 

MSM51210 

MSM51220 

MSM51230 

MSM51240 

MSM51250 

MSM51260 

MSM51270 

MSM51280 

MSM51290 

MSM51300 

MSM51310 

MSM51320 

MSM51330 

MSM51340 

MSM51350 

MSM51360 

MSM51370 

MSM51380 

MSM51390 

MSM51400 

MSM51410 

MSM51420 

MSM51430 

MSM51440 

MSM51450 

MSM51460 

MSM51470 

MSM51480 

MSM51490 

MSM51500 

MSM51510 

MSM51520 

MSM51530 

MSM51540 

MSM51550 

MSM51560 

MSM51570 

MSM51580 

MSM51590 

MSM51600 

MSM51610 

MSM51620 

MSM51630 

MSM51640 

MSM51650 

MSM51660 

MSM51670 

MSM51680 

MSM51690 

MSM51700 

MSM51710 

MSM51720 

MSM51730 

MSM51740 

MSM51750 

MSM51760 

MSM51770 

MSM51780 

MSM51790 

MSM51800 

MSM51810 

MSM51820 

MSM51830 


oo  oooo  oo  oo 


msml.for 


C  DO  LOOP  OVER  LOCAL  TIME  GRID  PTS 
DO  10  J-1,LTDIM 

IBEG-BNDLOC ( J, ITT) 

DO  LOOP  OVER  LATITUDINAL  GRID  PTS 
DO  20  I=IBEG, LATDIM 

RVAL= (1 . -BT+FT) *R (I, J, ITT) + (BT-FT) *R (I, J, ITT+1) 

VMVAL- (1 . -BT+FT) *VM (I, J, ITT) + (BT-FT) *VM (I, J, ITT+1) 
IF(RVAL.EQ.O.)  WRITE(6,*)  RVAL=',RVAL 

IF(VMVAL.EQ.O.)  WRITE(6,*)  'I>=',I,'  VMVAL= '  ,  VMVAL 

DO  LOOP  OVER  ENERGY  SPECIES 
DO  30  IE=1,IEMAX 

ISP=IFLAV(IE) 

ENRG=ABS (ALAM(IE) ) *VMVAL 
FKP=- (KPDlM+2) 

IF(RVAL.GE.6.6)  THEN 

FLXREF (I,  J,  IE) =FLXVAL (ISP,  FKP, RVAL, PP, ENRG, IRDIM, 

2  NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXMAT, FLXR, FLXNRG, 

3  FLXKP) 

ELSE 

EGEO=ENRG* (RVAL/6. 6) •* (8-/3. ) 
FLXGEO=FLXVAL(ISP,FKP, 6.6,PP,EGEO, IRDIM, 

2  NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXMAT, FLXR, FLXNRG, 

3  FLXKP) 

FLXREF (I, J, IE) =( (6.6/RVAL)** (8./3.) ) *FLXGEO 
END  IF 


30  CONTINUE 

20  CONTINUE 
10  CONTINUE 


RETURN 

END 

SUBROUTINE  EFLOC (RVAL, XLT, LL, LATDIM, LTDIM, ITMDIM, 

2  R, ALOCT,BI,BJ) 

C 

C  PURPOSE:  FIND  GRID  LOCATION  (BI,BJ)  OF  PHYSICAL  LOCATIONS  GIVEN  BY 
C  (RVAL, XLT, LL) 

C 

C  VERSION  1.00  DATE:  09.13.89 

C 

C 

C  INPUT : 

C  RVAL  RADIAL  DISTANCE  (RE) 

C  XLT  HOUR  ANGLE  MEASURED  EASTWARD  FROM  NOON  (RADIAN) 

C  LL  TIME  INDEX 

C  LATDIM  NUMBER  OF  LATITUDINAL  GRID  PTS 

C  LTDIM  MAX  NUMBER  OF  LOCAL  TIME  GRID  PTS  (INCL  WRAPAROUND) 

C  ITMDIM  MAX  NUMBER  OF  TEMPORAL  GRID  PTS 

C  PARAMETERS  ARE  CALCULATED 

C  R  RADIAL  DISTANCE  ARRAY  (RE) 

C  ALOCT  HOUR  ANGLE  ARRAY  (RADIANS) 

C 

C  OUTPUT : 

C  BI  NON-INTEGER  I  LOCATION  OF  (RVAL, XLT) 

C  BJ  NON-INTEGER  J  LOCATION  OF  (RVAL, XLT) 

C 

C  PROGRAMMER:  R.W.  SPIRO 
C 


MSM51840 

MSM51850 

MSM51860 

MSM51870 

MSM51880 

MSM51890 

MSM51900 

MSM51910 

MSM51920 

MSM51930 

MSM51940 

MSM51950 

MSM51960 

MSM51970 

MSM51980 

MSM51990 

MSM52000 

MSM52010 

MSM52020 

MSM52030 

MSM52040 

MSM52050 

MSM52060 

MSM52070 

MSM52080 

MSM52090 

MSM52100 

MSM52110 

MSM52120 

MSM52130 

MSM52140 

MSM52150 

MSM52160 

MSM52170 

MSM52180 

MSM52190 

MSM52200 

MSM52210 

MSM52220 

MSM52230 

MSM52240 

MSM52250 

MSM52260 

MSM52270 

MSM52280 

MSM52290 

MSM52300 

MSM52310 

MSM52320 

MSM52330 

MSM52340 

MSM52350 

MSM52360 

MSM52370 

MSM52380 

MSM52390 

MSM52400 

MSM52410 

MSM52420 

MSM52430 

MSM52440 

MSM52450 

MSM52460 

MSM52470 


msml.for 


DIMENSION  R (LATDIM, LTDIM, ITMDIM) , ALOCT (LATDIM, LTDIM) 


PI=ATAN2 (0. , -1 • ) 


SEARCH  GRID  AND  TRY  TO  LOCALIZE  (RVAL,XLT)  WITHIN  A  GRID  SQUARE 
DO  30  J=2,LTDIM-2 
JJ=J 

DO  40  1=2, LATDIM 
II-I 

GET  XLT, ALOCT (I, J) ,  AND  ALOCT(I,J+l)  IN  SAME  MODULUS 
CALL  PFIX(XLT,ALOCT(I, J) , ALOCT ( I , J+1 ) ,P4,P5) 

WRITE (6, *)  I, J,RVAL,R(I-1, J,LL) ,R(I, J,  LL) ,XLT,P4,P5 

IF(RVAL.LE.R(I-1,  J,LL) 

2  .AND. 

3  RVAL.GT.Rd,  J,LL) 

4  .AND. 

5  XLT.GE.P4 

6  .AND. 

7  XLT.LT.P5) 

8  THEN 

GO  TO  50 
END  IF 

40  CONTINUE 
30  CONTINUE 

WRITE (6,*)  'STOPPING  IN  EFLOC' 

WRITECe,*)  'UNABLE  TO  FIND  (BI,BJ)' 

WRITE (6,*)  'RVAL=  ' , RVAL, '  XLT=  '  ,  XLT 
STOP 


50  CONTINUE 

DO  45  IK=2, LATDIM 
IIK=IK 

IF{RVAL.LE.R{IK-1,  J+1,LL)  .AND.RVAL.GT.RdK,  J+1,LL)  )  GO  TO  60 
45  CONTINUE 

WRITE (6,*)  'STOPPING  IN  EFLOC' 

WRITE (6,*)  'UNABLE  TO  FIND  (BI,BJ)' 

WRITE (6,*)  'RVAL=  ' , RVAL, '  XLT=  '  , XLT 
STOP 

60  CONTINUE 


COMPUTE  COEFFICIENTS  FOR  INTERPOLATION 

Fl-(RVAL-RdI-l,  JJ,  LL)  )  /  (Rdl,  JJ,  LL)  -R  (II-l ,  JJ,  LL)  )  +FLOAT  (II-l) 


MSM52480 

MSM52490 

MSM52500 

MSM52510 

MSM52520 

MSM52530 

MSM52540 

MSM52550 

MSM52560 

MSM52570 

MSM52580 

MSM52590 

MSM52600 

MSM52610 

MSM52620 

MSM52630 

MSM52640 

MSM52650 

MSM52660 

MSM52670 

MSM52680 

MSM52690 

MSM52700 

MSM52710 

MSM52720 

MSM52730 

MSM52740 

MSM52750 

MSM52760 

MSM52770 

MSM52780 

MSM52790 

MSM52800 

MSM52810 

MSM52820 

MSM52830 

MSM52840 

MSM52850 

MSM52860 

MSM52870 

MSM52880 

MSM52890 

MSM52900 

MSM52910 

MSM52920 

MSM52930 

MSM52940 

MSM52950 

MSM52960 

MSM52970 

MSM52980 

MSM52990 

MSM53000 

MSM53010 

MSM53020 

MSM53030 

MSM53040 

MSM53050 

MSM53060 

MSM53070 

MSM53080 

MSM53090 

MSM53100 

MSM53110 


oo  ooonooooonoo  ono  oo 


CALL  PFIX (XLT, ALOCT (il, JJ) , ALOCT ( IIK, JJ+1 ) ,P4,P5) 

C 

BJ»(XLT-P4) / (P5-P4)+FLOAT(JJ) 

C 

BI=F1+  (BJ-FLOAT  (JJ)  )  *  'r2-Fl)  /  (FLOAT  ( JJ+j. <  -FLOAT  (JJ)  ) 


RETURN 

END 


SUBROUTINE  EFBNDY (LATDIM, LTDIM, ITMDIM,LL, EQEDG, STDOFF, VDROP , R, 

2  ALOCT,COLAT, A,B,DX,Dy) 

VERSION  1.00  DATE:  09.13.89 

1.01  10.25.89 

PURPOSE; 

SUBROUTINE  TO  CALCULATE  LATITUDES  AND  WIDTHS  OF  EFIELD  BNDYS  2  &  3 
PROGRAMMER:  R.W.  SPIRO 

REF:  SECTION  2.4.2  OF  THE  FINAL  REPORT  FOR 
CONTRACT  #F19628-87-K-0001 


DIMENSION  R ( LATDIM, LTDIM, ITMDIM) , ALOCT (LATDIM, LTDIM) 
DIMENSION  COLAT (LATDIM, LTDIM) 

DIMENSION  A(3) ,B(3) ,DX(3) ,DY(3) 

DIMENSION  XLAMDA(4, 3) ,DLAMDA{4) 


PI=ATAN2(0.,-1.) 

C 

WRITE(6,*)  'IN  EFBNDY  EQEDG=  ' , EQEDG, ' STDOFF=  ' , STDOFF 
C 

RNOON=. 95* STDOFF 
RDAWN=1 . 4* STDOFF 
RDUSK=1 . 4* STDOFF 
RMIDNT=2 . 0* STDOFF 
C 
C 

C  XLAMDA(1,N)  REFERS  TO  NOON;  XLAMDA(2,N)  REFERS  TO  DUSK 
C  XLAMDA(3,N)  REFERS  TO  MIDNIGHT;  XLAMDA(4,N)  REFERS  TO  DAWN 
C  WHERE  N=l,2,3  REFERS  TO  THE  THREE  BNDYS  OF  THE  E  FIELD  CALCULATION 
C  BNDY  1  IS  CALCULATED  INTERNALLY  IN  EFIELD 
C  BNDYS  2  AND  3  ARE  CALCULATED  HERE 
C 

XLAMDA (3,3) =EQEDG 
XLAMDA (2,3) =EQEDG+ 1 . 

XLAMDA(4, 3)=EQEDG+1 . 

XLAMDA (1, 3) =EQEDG+( ( 66 . 95-EOEDG) *7 . 725+2 . 8* (EQEDG-56.8) ) /10.15 
C 
C 

C  CALCULATION  OF  PARAMETERS  USED  IN  CALCULATING  BNDY  2 
C 

C  LOCATE  RNOON,RDAWN,  RDUSK,  AND  RMIDNT  IN  OUR  GRID,  IE.,  FIND 
C  (BINOON, BJNOON) ,  (BIDUSK, BJDUSK) ,  (BIMDNT, BJMDNT) ,  (BIDAWN, BJD AWN) 
C 

TNOON"0 . 

CALL  EFLOC (RNOON, TNOON, LL, LATDIM, LTDIM, ITMDIM, R, ALOCT, 


MSM53120 

MSM53130 

MSM53140 

MSM53150 

MSM53160 

MSM53170 

MSM53180 

MSM53190 

MSM53200 

MSM53210 

MSM53220 

MSM53230 

MSM53240 

MSM5325G 

MSM53260 

MSM53270 

MSM53280 

MSM53290 

MSM53300 

MSM53310 

MSM53320 

MSM53330 

MSM53340 

M;-M53350 

MSM53360 

MSM53370 

MSM53380 

MSM53390 

MSM53400 

MSM53410 

MSM53420 

MSM55430 

MSM53440 

MSM53450 

MSM53460 

MSM53470 

MSM53480 

MSM53490 

MSM53500 

MSM53510 

MSM53520 

MSM53530 

MSM53540 

MSM53550 

MSM53560 

MSM53570 

MSM53580 

MSM53590 

MSM53600 

MSM53610 

MSM53620 

MSM53630 

MSM53640 

MSM53650 

MSM53660 

MSM53670 

MSM53680 

MSM53690 

MSM53700 

MSM5371C 

MSM53720 

MSM53730 

MSM53740 

MSM53750 


BINOON, BJNOON) 


msml.for 


TDUSK=PI/2. 

CALL  EFLOC (RDUSK, TDUSK, LL, LATDIM, LTDIM, ITMDIM, R, ALOCT, 
2  BIDUSK, BJDUSK) 


C 

C 

TMIDNT=PI 

CALL  EFLOC (RMIDNT, TMIDNT, LL, LATDIM, LTDIM, ITMDIM, R, ALOCT, 
2  BIMDNT,BJMDNT) 


TDAWN=3.*PI/2. 

CALL  EFLOC (RDAWN, TDAWN, LL, LATDIM, LTDIM,  ITMDIM, R,  ALOCT, 
2  BIDAWN, BJDAWN) 


C 

C 

XLAT1=G3NTRP (COLAT, LATDIM, LTDIM, 1, BINOON, BJNOON, 1 . ) 

XLAMDA (1,2)= (PI/2. -XLATl) *180. /PI 
C 

XLAT2=G3NTRP (COLAT, LATDIM, LTDIM, 1, BIDUSK, BJDUSK, 1 . ) 
XLAMDA(2,2)=(PI/2.-XLAT2) *180./PI 
C 

XLAT3=G3NTRP (COLAT, LATDIM, LTDIM, 1, BIMDNT, BJMDNT, 1 . ) 
xlamda(3,2)=(pi/2.-xlat3) *180. /pi 
C 

XLAT4=G3NTRP (COLAT, LATDIM, LTDIM, 1 , BIDAWN, BJDAWN, 1 . ) 
XLAMDA(4,2)=(PI/2.-XLAT4) *180. /PI 
C 

C  CHECK  BOUNDARY  3  (EQ.  EDGE  OF  SUNWARD  FLOW)  FOR  RIDICULOUS  VALUE; 
C  CHANGE  IF  NECESSARY 
C 

EMAX=.l 

DLAMDA(1)=3. 

DLAMDA(3)=3. 

DLAMDA (2) =4 . 5E-6*VDROP/EMAX 
DLAMDA ( 4 ) =DLAMDA ( 2 ) 


C 

C  LOOP  OVER  NOON,  DUSK,  MIDNIGHT,  AND  DAWN 
DO  8  11-1,4 

DELTA-XLAMDA (11,2) -DLAMDA (II) -XLAMDA (11,3) 

IF (DELTA. LT. 0. )  THEN 

WRITE (6,*)  'ADJUSTING  XLAMDA (II, 3)  IN  EFBNDY' 

WRITE(6,*)  'LL=',LL,'  11=', II,'  XLAMDA (OLD) =', XLAMDA ( II , 3 ) 
XLAMDA (II, 3)=XLAMDA(II,3)+DELTA 

WRITE (6,*)  '  XLAMDA (NEW) =', XLAMDA (II, 3) 

END  IF 
8  CONTINUE 
C 
C 

DO  10  11-2,3 

DX(II)— .5*  (XLAMDA  (1,  II)  -XLAMDA  (3,11)  ) 

DY(II)  — .5*  (XLAMDA  (2,  II) -XLAMDA  (4,  II)  ) 

C 

X-.5* (180. -XLAMDA (1,11) -XLAMDA (3, II) ) 

Y-.5* (180. -XLAMDA (4, II) -XLAMDA (2, II) ) 

C 

A (II) -SORT ( ( (X*Y) **2-(DX(II)*DY(II) )**2) / (Y**2-DY (II) **2) ) 
B(II)-SQRT( ( (X*Y)**2-(DX(II) *DY(II) )**2) / (X**2-DX (II) **2) ) 

C 

10  CONTINUE 
C 
C 

RETURN 

END 
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Q  ****************************  F  E  C  O  N  *************************** 
C 

SUBROUTINE  FECON (ISTART, IINC, lEND, ITMDIM, NAUGEL, MODE, AUGPAR, 

1  ITMMAX,TIMTAG) 


C  VERSION  1 . 0 


DATE:  JANUARY  9,  1988 

SEPTEMBER  14,  1989 


C  PROGRAMMER:  BRYAN  A.  BALES 
C 

C  PURPOSE:  FECON  CALLS  PARGEN  TO  OBTAIN  TIME-NORMALIZED  OBSERVED  DATA 
C  THAT  IS  THEN  USED  TO  CALCULATE  OTHER  VALUES  NEEDED  BY  THE 

C  EFIELD  AND  BFIELD  ROUTINES. 

C 

PARAMETER  (NELTS=28, ITDIM=50) 


INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN,  IPSEC, KP,  DST, DDST, 
EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 
GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTH, 
STAND, PCP,DEQDT, IPATT 

LOGICAL*!  MODE (NAUGEL, ITMDIM) 

COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR,  IPMIN,  IPSEC,  KP,DST, 
EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ,  CLAPSE, 
GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTH, 
STAND, PCP, IPATT, DDST, DEQDT 


DIMENSION  PARRAY (NELTS, ITDIM) , AUGPAR (NAUGEL, ITMDIM) , ITIME (3) 
DIMENSION  ITMNEW (3) , ISTART (3) , IINC (3) , lEND (3) 

DIMENSION  TIMTAG (ITMDIM) 

IF  ( ITDIM. NE. ITMDIM)  STOP  'STOPPING  IN  FECON.  ITDIM. NE. ITMDIM' 

DO  30  IDO=l, NAUGEL 
DO  40  JDO=l, ITMDIM 
MODE (IDO, JDO) = . FALSE . 

CONTINUE 

CONTINUE 

CALL  PARGEN (ISTART, IINC, lEND, ITMDIM, NELTS, MODE, PARRAY, 

ITMMAX, TIMTAG,  NAUGEL) 

ITIME (1)  =  ISTART (1) 

ITIME (2)  =  ISTART (2) 

ITIME (3)  =  ISTART (3) 

DO  20,  ITM=1,  ITMMAX 
DO  10,  1=1,  NELTS 

AUGPARd,  ITM)  =  PARRAY  (I,  ITM) 

CONTINUE 

CALL  TILT (ITIME (IDAY) , ITIME (lYEAR) , AUGPAR (TILTH, ITM) ) 

CALL  STNDFL (MODE (STAND, ITM) , MODE (SWVEL, ITM) , 

MODE (SWDEN, ITM) , PARRAY (SWVEL, ITM) , PARRAY ( SWDEN, ITM) , 
PARRAY (KP, ITM) , AUGPAR (STAND, ITM) ) 

CALL  DSTDFL (MODE (DST, ITM) , AUGPAR, NAUGEL, ITMDIM, ITM, ITMMAX, 
TIMTAG) 

CALL  EQTDFL (MODE (EQEDGE, ITM) , AUGPAR, NAUGEL, ITMDIM, ITM, 
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C 

C 


20 
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ITMMAX,TIMTAG) 

CALL  PCPDFL(MODE(PCP,ITM) , PARRAY (KP, ITM) , AUGPAR (PCP,  ITM) ) 

CALL  PATDFL (MODE (IPATT, ITM) , MODE (IMFBY, ITM) , 

MODE (IMFBZ, ITM) , PARRAY (IMFBY, ITM) , 

PARRAY (IMFBZ, ITM) , AUGPAR (IPATT, ITM) ) 

CALL  CLPDFL (MODE (CLAPSE, ITM) , AUGPAR (CLAPSE, ITM) ) 


CALL  TIMINC(ITIME,ITMNEW,IINC) 
ITIME(l)  =  ITMNEW(l) 

ITIME(2)  =  ITMNEW(2) 

ITIME(3)  =  ITMNEWO) 

CONTINUE 

RETURN 


END 

C 

Q  ****************************  p  A  R  G  E  N  *********************** 
C 

SUBROUTINE  PARGEN (ISTART, IINC, lEND, ITMDIM, NELTS,MODE, PARRAY, 
1  ITMM?.X,  TIMTAG,  NAUGEL) 


C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 


VERSION  1.0 

2.0 

PROGRAMMER:  BRYAN  A.  BALES 


DATE:  JANUARY  9,  1988 

SEPTEMBER  14,  1989 
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C 

C 


C 

C 


MSM55330 

PURPOSE:  PARGEN  GETS  OBSERVED  VALUES  FROM  THE  ENVIRONMENTAL  DATABASEMSM55340 

AND  PERFORMS  AN  INTERPOLATION  OR  EXTRAPOLATION  AS  APPROPRIATE  MSM55350 

MSM55360 
MSM55370 
MSM55380 
MSM55390 
MSM55400 
MSM55410 
MSM55420 
MSM55430 
MSM55440 
MSM55450 
MSM55460 
MSM55470 
MSM55480 
MSM55490 
,MSM55500 
MSM55510 
MSM55520 
MSM55530 
MSM55540 
MSM55550 
MSM55560 
MSM55570 
MSM55580 
MSM55590 
MSM55600 
MSM55610 
MSM55620 
MSM55630 
MSM55640 

IF  (NPELTS.NE.NELTS)  STOP  'STOPPING  IN  PARGEN.  NELTS.NE.NPELTS'MSM55650 
IF (NAUGL.NE. NAUGEL)  STOP  'STOPPING  IN  PARGEN.  NAUGL.NE. NAUGEL' MSM55 660 

MSM55670 


1 

2 

3 


1 

2 


1 

2 

3 


TO  PROVIDE  DATA  AT  A  NORMALIZED  TIME. 

PARAMETER  (NPELTS=28 , NDIM=8  0 , NAUGL=28 ) 

CHARACTER* 6  PARAM (NPELTS) 

LOGICAL*!  MODE (NAUGEL, ITMDIM) 

INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP, DST, DDST, 
EQEDGE,DLATAZ,DLATRV,MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 
GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 
STAND, PCP, DEQDT,  IPATT 

DATA  PARAM  / '  ' , '  ' , '  ' , '  ' , '  ' , ' FKP' , ' DST' , ' EQEDGE' , '  ' , '  ' , 
'  ',' IMFBX', 'IMFBY', 'IMFBZ', 'CLAPSE','  ','  ','  ','  ',' 

' SWVEL' ,' SWDEN' , '  ','  ',' PCP' ,' XIPATT' ,' DDST' ,' DEQDT' / 


COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP, DST, 
EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 
GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 
STAND, PCP , IPATT, DDST, DEQDT 

DIMENSION  PARRAY (NELTS, ITMDIM) , ISTART (3) , IINC (3) , IEND(3) 
DIMENSION  DARRY(7,NDIM) ,ITIME(3) ,ITMNEW(3) , IGAP (NAUGL) 
DIMENSION  TIMTAG (ITMDIM) ,XA(NDIM) ,YA(NDIM) , XKPMAT (3, NDIM) 

DATA  IGAP  /5*0, 86400, 86400, 28800, 16*0, 39744, 31104, 2*0/ 


♦  ♦ 


c 


1 

2 


C 


c 

c 


42 

C 

C 


C 

20 


C 


C 


msml.for 


REND  =  TCONV3 (lEND, ISTART) 
NODATA  -  0 


DO  10,  1=6, 
ITM  =  1 
ITIME(l) 
ITIME{2) 
ITIME(3) 


NELTS 

=  ISTART (1) 
=  ISTART (2) 
=  ISTART (3) 


IF  ( I . EQ . KP . OR . I . EQ . DST . OR . I . EQ . PCP . OR . I . EQ . IPATT . OR . 

I . EQ . CLAPSE . OR . I . EQ . SWDEN . OR. I . EQ . SWVEL . OR . 

I.EQ.EQEDGE)  THEN 

CALL  INDATA (P ARAM (I) , ISTART, lEND, NDIM, DARRY, NUMNUM) 

;;rite(6,*)  'coming  out  of  indata,  i=  ',i,'  numnum=  ',numnum 

IF( (NUMNUM. EQ.O) .AND. (I . EQ . KP) ) THEN 
WRITE (6,*)'  NO  KP  AVAILABLE  TO  RUN  PROGRAM.' 

STOP 

ENDIF 

STARTY  =  REAL (ISTART (1 ) ) 

IF(ISTART(3) .LT. 86400)  THEN 

STARTD  =  REAL (ISTART (2) )  +  REAL (ISTART (3) ) /86400 . 

ELSE  IF(ISTART(3) .EQ. 86400)  THEN 
STARTD=REAL (ISTART (2) ) 

ELSE 

WRITE (6,*)  'INCORRECT  START  TIME  HAS  BEEN  INPUT' 

WRITE (6,*)  'STOPPING  PROGRAM  IN  PARGEN' 

STOP 
END  IF 

CALL  SMOOTH (DARRY, NDIM, NUMNUM, STARTY, STARTD, NA, XA, YA, lERR) 

WRITE ( 6, * )  '  NA=  ' , NA, '  NUMNUM=' , NUMNUM, '  NDIM=' , NDIM 
DO  42  NX=1,NA 

WRITE (6,*)  '  TIME=' ,XA(NX) , '  VALUE=' , YA (NX) 

CONTINUE 

WRITE  (6,*)  'RETURNED  FROM  SMOOTH  FOR  PARAMETER  ',PARAM(I) 
IF  (lERR.NE.O)  THEN 

WRITE  (6,*)  'TIME  REVERSAL  IN  PARAMETER  ',PARAM(I) 

STOP  'SERIOUS  ERROR  IN  ENVIRONMENTAL  DATA.' 

ENDIF 

IF (NUMNUM. EQ.O) GO  TO  10 
CONTINUE 

IF  (I.EQ.KP)  THEN 

PARRAYdYEAR,  ITM)  =  ITIME(IYEAR) 

PARRAY(IDAY,ITM)  =  ITIME(IDAY) 

PARRAYdPHOUR,  ITM)  =  REAL  (ITIME  (ISECND) /3600) 
PARRAYdPMIN,  ITM)  =  REAL  (MOD  (ITIME  (ISECND)  ,  3600) /60) 
PARRAY(IPSEC,ITM)  =  REAL (MOD (ITIME (ISECND) , 60) ) 
TIMTAGdTM)  =  TCONV3  (ITIME,  ISTART) 

WRITE (6,*)  'TIMTAG(' ,ITM, ' )  =  ',TIMTAG(ITM) 

ENDIF 

IF  (I.EQ. IPATT)  THEN 

CALL  DTXIPT (TIMTAG (ITM) ,NA,XA,yA, Y,DYDX, DELTA, lERR) 
PARRAYd,ITM)  =  Y 

ELSEIF  (I .NE.DDST.AND. I .NE.DEQDT)  THEN 

CALL  DTNTRP (TIMTAG (ITM) , NA, XA, YA, Y, DYDX, DELTA, lERR) 

PARRAY(I,ITM)  =  Y 
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msml.for 

IF( (DELTA. LE.IGAP (I) ) .OR. (IGAP (I) .EQ.O) ) THEN 
MODE(I,ITM)  =  .TRUE. 

ELSE 

MODE(I,ITM)  =  .FALSE. 

END  IF 


C 

C 

C 


C 


C 

C 


DYDX  IS  IN  UNITS  OF  Y/SEC 

NEED  TO  CHANGE  TO  UNITS  OF  Y/HOUR 

IF  (I.EQ.DST)  PARRAY (DOST, ITM)  =  DYDX*3600. 

IF  (I.EQ.EQEDGE)  PARRAY (DEQDT, ITM)  =  DYDX*3600. 
IF(I.EQ.DST) 

1  WRITE (6,*)'  ITM, DST, DYDX  ' , TIMTAG ( ITM) , 

1  PARRAY (DST, ITM) , PARRAY (DDST, ITM) 

IF (I.EQ.EQEDGE) 

2  WRITE(6,*)'  ITM, EQED, DYDX' , TIMTAG (ITM) , 

1  PARRAY (EQEDGE, ITM) , PARRAY (DEQDT, ITM) 

ENDIF 

ITM  =  ITM  +  1 

CALL  TIMINCdTIME,  ITMNEW,  UNO 
ITIME(l)  =  ITMNEW(l) 

ITIME(2)  =  ITMNEW (2) 

ITIME(3)  =  ITMNEW (3) 

IF  (NINT(TCONV3(ITIME,ISTART) ) .LE.NINT(REND) )  GO  TO  20 

IF  (I.EQ.KP)  ITMMAX  =  ITM-1 
ENDIF 


C 

10  CONTINUE 

C 

RETURN 

END 
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C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


C 

10 


C 

C 

20 
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★  *★*★★*★★★★★**★*■***★***★★*****  indata  ^t***^*******************!*^**** *MSM5 6660 


SUBROUTINE  INDATA (PARAM, STARTT, ENDT, NDIM, DARRY, NUMNUM) 

THIS  IS  A  DUMMY  SUBROUTINE  TO  READ  IN  DATA  FOR  THE 
MAGNETOSHPERIC  SPECIFICATION  MODEL  DURING  DEVELOPMENT 
AND  TESTING.  THIS  ROUTINE  WILL  BE  REPLACED  IN  THE 
OPERATIONAL  MSM  WITH  AN  INTERFACE  ROUTINE  TO  THE 
AWS  ENVIRONMENTAL  DATABASE. 

BRYAN  BALES  9/12/89 

CHARACTER* ( * )  PARAM 

DIMENSION  STARTT(3) ,ENDT(3) , DARRY (7, NDIM) 

NUMNt^l  =  1 

OPEN  (UNIT=98,FILE=PARAM, STATUS='OLD' ) 

CONTINUE 

READ  (98, *,END=20)  (DARRY (I, NUMNUM) , 1=1 , 7) 

NUMNUM  =  NUMNUM  +  1 
IF  (NUMNUM. LE. NDIM)  GO  TO  10 

STOP  'Stopping  in  INDATA.  NUMNUM  is  greater  than  NDIM.' 
CONTINUE 

NUMNUM  =  NUMNUM  -  1 
CLOSE  (98) 
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msml.for 


THIS  SUBROUTINE  FINDS  THE  MAGNETIC  FIELD  MATRICES  NEEDED  TO 
INTERPOLATE  ONE  MATRIX  THAT  IS  REPRESENTATIVE  OF  CURRENT 
CONDITIONS. 


BRYAN  BALES 


9/12/89 


RETURN  MSM56960 

END  MSM56970 

MSM56980 

******************************  getmat  ******************** **********msM56990 

MSM57000 

SUBROUTINE  GETMAT ( IWANT, LATDIM, LTDIM, BFPAR, WORK, BFLIM, BFEXST)  MSM57010 

MSM57020 

THIS  SUBROUTINE  FINDS  THE  MAGNETIC  FIELD  MATRICES  NEEDED  TO  MSM57030 

INTERPOLATE  ONE  MATRIX  THAT  IS  REPRESENTATIVE  OF  CURRENT  MSM57040 

CONDITIONS.  MSM57050 

MSM57060 

BRYAN  BALES  9/12/89  MSM57070 

MSM57080 

PARAMETER  (IMSTND=5, IMTILT=5, IMINED=16, IMDST=8,  IMSTCH=2)  MSM57090 

MSM57100 

INTEGER  BFNDX(2,5)  MSM57110 

LOGICAL*!  BFEXST (2, 2, 2, 2, 2)  MSM57120 

LOGICAL  MEXIST  MSM57130 

MSM57140 

DIMENSION  STNDPR(IMSTND) ,TILTPR{IMTILT) ,FINEDP (IMINED)  MSM57150 

DIMENSION  DSTPR(IMDST) , STCHPR(IMSTCH)  MSM57160 

DIMENSION  BFLIM (2, 5) , BFPAR (5)  MSM57170 

DIMENSION  WORK(LATDIM, LTDIM, 2,2,2,2,2)  MSM57180 

DIMENSION  XDEB(62,51),YDEB(62,51),2;DEB(62,51)  MSM57190 

DATA  MSTND/IMSTND/  MSM57200 

DATA  MTILT/IMTILT/  MSM57210 

DATA  MINED/ IMINED/  MSM57220 

DATA  MDST/IMDST/  MSM57230 

DATA  MSTCH/IMSTCH/  MSM57240 

MSM57250 


PARAMETER  (IMSTND=5, IMTILT=5, IMINED=16, IMDST=8, IMSTCH=2) 

INTEGER  BFNDX(2,5) 

LOGICAL*!  BFEXST (2, 2, 2, 2, 2) 

LOGICAL  MEXIST 

DIMENSION  STNDPR(IMSTND) , TILTPR (IMTILT) , FINEDP (IMINED) 
DIMENSION  DSTPR(IMDST) , STCHPR (IMSTCH) 

DIMENSION  BFLIM (2, 5) , BFPAR (5) 

DIMENSION  WORK (LATDIM, LTDIM, 2, 2, 2, 2, 2) 

DIMENSION  XDEB(62,51)  ,YDEB(62, 51)  ,2;DEB(62,  51) 

DATA  MSTND/IMSTND/ 

DATA  MTILT/IMTILT/ 

DATA  MINED/ IMINED/ 

DATA  MDST/IMDST/ 

DATA  MSTCH/IMSTCH/ 


DATA 

STNDPR/6.0, 8. 

0,10.0,12.0,14.0/ 

MSM57260 

DATA 

TILTPR/-35.0, 

-17.5,0.0,17.5,35.0/ 

MSM57270 

DATA 

FINEDP/49.47, 

53.20,  55.89,  57.96,  59.60, 

MSM57280 

1 

60.95, 

62.06,  63.02,  63.99,  65.01, 

MSM57290 

2 

65.91, 

66.72,  67.45,  68.12,  68.73, 

MSM57300 

3 

69.30/ 

MSM57310 

DATA 

DSTPR/-400.0, 

-300.0,  -200.0,  -150.0, 

MSM57320 

1 

-100.0, 

-50.0,  0.0,  50.0/ 

MSM57330 

DATA 

STCHPR/ 0.0,  1 

.0/ 

MSM57340 

EXTERNAL  MEXIST 

CALL  FNDBRK (BFPAR (1 ) ,STNDPR,MSTND, BFNDX (1,1) ,BFNDX (2,1) ) 
CALL  FNDBRK (BFPAR (2) , TILTPR, MTILT, BFNDX (1, 2)  ,  BFNDX (2, 2) ) 
CALL  FNDBRK (BFPAR (3) , FINEDP, MINED, BFNDX (1, 3) , BFNDX (2, 3) ) 
CALL  FNDBRK (BFPAR (4) ,DSTPR,  MDST,  BFNDX (1 , 4 ) , BFNDX (2, 4 ) ) 
CALL  FNDBRK (BFPAR (5) , STCHPR, MSTCH, BFNDX (1, 5) , BFNDX (2, 5) ) 


DO  5,  1=1,2 
BFLIMd,  1) 
BFLIM (I, 2) 
BFLIMd,  3) 
BFLIM (1,4) 
BFLIMd,  5) 
CONTINUE 


STNDPR(BFNDX (I, 1) ) 
TILTPR (BFNDX (1,2) ) 
FINEDP (BFNDX (1,3) ) 
DSTPR(BFNDXd,4)  ) 
STCHPR (BFNDX (1,5) ) 


DO  10,  1=1,2 
DO  20,  J=l,2 
DO  30,  K=l,2 
DO  40,  L=l,2 
DO  50,  M=l,2 

IF  (MEXIST  (BFNDX  (I,  1)  ,  BFNDX  (J,2)  ,  BFNDX  (K,  3)  , 
1  BFNDX (L, 4), BFNDX (M, 5)))  THEN 
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CALL  LOADBM (IWANT, LATDIM, LTDIM, I , J, K, L, M, BFNDX, 
1  WORK) 

BFEXSTd,  J,K,L,M)  =  .TRUE. 

ELSE 

CALL  ZEROBM (LATDIM, LTDIM, I, J,K,L,M, WORK) 
BFEXSTd,  J,K,L,M)  =  .FALSE. 

ENDIF 


C 

C 

C  1 

C  2 

C  3 

c 

C  1 

ClOOl 


2 

3 

4 

1001  FORMAT ( 
2 
3 


C 

C 

C 

C 

998 

999 
C 

C 

C 

C 

C 

C 

C 

996 

997 
C 

C 

C 

c 

c 

c 

c 

994 

995 
C 

C 

C 

C 


1 


1 


1 


IF(BFNDX(J,2) .EQ.3.AND.IWANT.EQ.1)  THEN 

IF((3-BFNDX(M, 5)) . EQ . 1 . OR. BFPAR (5) .LT.l)  THEN 

WRITE  (6,*)  'STANDOFF  =',BFLIM (1,1),'  TILT  =' , 
BFLIM(J,2),'  EQEDGE  =' , BFLIM (K, 3) , 

'  DST  =',BFLIM(L,4),'  COLLAPSE', 

BFLIM (M, 5) 

WRITE  (6,1001)  BFNDX(J,2) ,BFNDX(I,1) ,BFNDX(L,4) , 
BFNDX (K, 3) , (3-BFNDX(M, 5) ) 

FORMAT  ('  BF' ,11,11,11,12.2,11) 

WRITE(6,1001)  BFNDX(J,2) ,BFNDX(I,1) ,BFNDX(L,4) , 
BFNDX (K, 3) , (3-BFNDX(M, 5) ) , BFEXST (I , J, K, L, M) , 
BFLIMd,!)  ,BFLIM(J,2),BFLIM(K,3)  , 

BFLIM (L, 4 ) , BFLIM (M, 5) 

BF' , 11 , I 1 , II , 12 . 2 , II , IX, LI , 3X, ' STANDOFF=  ' , F8 . 2 , 3X, 

TTLT=  ' ,F8.2,3X, 'EQEDGE=  ' , F8 . 2, 3X, ' DST=  ',F8.2,3X, 
COLLAPSE=  ',F4.2) 

END  IF 
END  IF 

IF( (IWANT. EQ.l) .AND. (BFEXST (I , J, K, L, M) ) ) THEN 
DO  999  LAT=1, LATDIM 
DO  998  LT=1, LTDIM 

XDEB (LAT, LT) =WORK (LAT, LT, I, J, K, L,M) 

CONTINUE 

CONTINUE 

CALL  OUTP (XDEB, LATDIM, LTDIM, 10, LATDIM, 1, 3, 
LTDlM-3, 1,1., 'XDEB' ,6,132) 

ENDIF 

IF( (IWANT. EQ. 2) .AND. (BFEXST (I , J, K, L, M) ) ) THEN 
DO  997  LAT=1, LATDIM 
DO  996  LT=1, LTDIM 

YDEB (LAT,  LT) =WORK (LAT, LT,I,J,K,L,M) 

CONTINUE 

CONTINUE 

CALL  OUTP (YDEB, LATDIM, LTDIM, 10, LATDIM, 1, 3, 
LTDIM-3,1,1.,'YDEB',6,132) 

ENDIF 

IF( (IWANT. EQ. 3) .AND. (BFEXST (I , J, K, L, M) ) ) THEN 
DO  995  LAT=1, LATDIM 
DO  994  LT=1, LTDIM 

ZDEB (LAT, LT) =WORK (LAT, LT, I, J, K, L,M) 

CONTINUE 

CONTINUE 

CALL  OUTP (ZDEB, LATDIM, LTDIM, 10, LATDIM, 1, 3, 
LTDIM-1, 1, 1 .  ,  '  ZDEB'  ,  6,  132) 

ENDIF 


50  CONTINUE 

40  CONTINUE 

30  CONTINUE 

20  CONTINUE 

10  CONTINUE 


C 


RETURN 

END 
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THIS  SUBROUTINE  FINDS  THE  INDICES  OF  THE  VALUES  IN  ARRAY 
PVALS  THAT  BRACKET  PARVAL. 

BRYAN  BALES  9/12/89 

DIMENSION  PVALS (IPDIM) 

MIN  =  0 

10  CONTINUE 

MIN  -  MIN  +  1 
MAX  =  MIN  +  1 

IF  (PARVAL . LE . PVALS (MIN) )  THEN 
MAX  =  MIN 

ELSEIF  (PARVAL. GT. PVALS (MAX) .AND. MAX. EQ. IPDIM)  THEN 
MIN  =  MAX 

IF  (PARVAL. GT. PVALS (MAX)  .AND.  M\X.LT. IPDIM)  THEN 
GO  TO  10 
ENDIF 

RETURN 

END 

*****************************  mexist  **************************** 

LOGICAL  FUNCTION  MEXIST (MSTND, MTILT, MINED, MDST, MSTCH) 

THIS  FUNCTION  CHECKS  TO  SEE  IF  A  PARTICULAR  B-MATRIX  EXISTS 
IN  THE  B-SUPERMATRIX(TM) . 

CHARACTER* 8  FILNAM 
LOGICAL  TEST 

WRITE  (FILNAM, 1000)  MTILT, MSTND,MDST, MINED, (3-MSTCH) 

1000  FORMAT  ('BFIELD:BF',I1,I1,I1,I2.2,I1,' .DAT') 

INQUIRE  (FILE=FILNAM,EXIST=TEST) 

MEXIST  -  TEST 

RETURN 

END 


MSM58690 

******************************  ZEROBM  ************ ******************MSM58700 


SUBROUTINE  ZEROBM (LATDIM, LTDIM, I, J, K, L, M, WORK) 

THIS  SUBROUTINE  ERASES  AN  INDIVIDUAL  B-MATRIX  WITHIN  THE 
WORKING  B-MATRICES.  THIS  IS  DONE  WHEN  AN  INDIVIDUAL  MATRIX 
DOES  NOT  EXIST  IN  THE  OFFLINE  B-SUPERMATRIX . 

DIMENSION  WORK ( LATDIM, LTDIM,  2 , 2 , 2 , 2 , 2 ) 

DO  10,  LAT=1,  LATDIM 
DO  20,  LT=1,  LTDIM 

WORK(LAT,LT,I, J,K,L,M)  =0.0 
20  CONTINUE 

10  CONTINUE 

C 

RETURN 

END 
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MSM58880 

LOADBM  ********************** ********mSM58890 


SUBROUTINE  LOADBM (IWANT, LATDIM, LTDIM, I, J, K, L, M, BFNDX, WORK) 

THIS  SUBROUTINE  LOADS  INDIVIDUAL  B-MATRICES  FROM  THE  OFFLINE 
B-SUPERMATRIX  INTO  THE  WORK  B-MATRICES.  A  CHECK  IS  MADE  TO 
VERIFY  THAT  THE  CORRECT  MATRIX  HAS  BEEN  RETRIEVED.  IF  THIS 
CHECK  FAILS  THE  PROGRAM  WILL  STOP. 

INTEGER  BFNDX (2, 5) 

CHARACTER* 32  FILNAM 

DIMENSION  WORK ( LATDIM, LTDIM, 2 , 2 , 2 , 2 , 2 ) 

THE  FILE  DEFINITIONS  FOR  THE  B-MATRICES  IN  THE  SUPERMATRIX 
ARE  AS  FOLLOWS  : 

' BFvwxyyz' . 

V’HERE  V  IS  THE  TILT  INDEX, 

w  IS  THE  STANDOFF  INDEX, 

X  IS  THE  DST  INDEX, 
yy  IS  THE  INNER  EDGE  INDEX, 
z  IS  THE  COLLAPSE  INDEX. 

WRITE  (FILNAM, 1000)  BFNDX (J, 2),  BFNDX (1,1),  BFNDX (L, 4), 

1  BFNDX (K, 3) , (3-BFNDX (M, 5) ) 

1000  FORMAT  ('BFIELD:BF',I1,I1,I1,I2.2,I1,' .DAT') 

OPEN  (UNIT=99,FILE=FILNAM,ERR=199,FORM=' FORMATTED' , 

1  ACCESS=' SEQUENTIAL' , STATUS='  OLD'  ) 

READ  (99,800)  IDFl,  IDF2,  IDF3,  IDF4,  IDF5,  IDF6 

800  FORMAT (311, 12,2,  II,  13) 

IF  ( (BFNDX(I,1) .NE.IDF2) .OR. (BFNDX(J,2) .NE.IDFl) .OR. 

1  (BFNDX (K, 3) .NE.IDF4) .OR. (BFNDX (L, 4) .NE.IDF3) .OR. 

2  ( (3-BFNDX (M, 5) ) .NE.IDF5) .OR. (IDF6.NE. 201) )  THEN 
WRITE  (LUERR, *)  'FILE  ', FILNAM, '  IS  INCORRECT.' 

WRITE  (6,*)  'FILE  ', FILNAM, '  IS  INCORRECT.' 

STOP  'INCORRECT  B-FIELD.  STOPPING  IN  LOADBM.' 

ENDIF 

DO  10,  N=l, IWANT 

READ(99,  801)  (  (WORKdl,  JJ,  I,  J,K,L,M)  ,  11  =  1, LATDIM)  ,JJ=1, LTDIM) 

801  FORMAT (11E12. 4) 

10  CONTINUE 

CLOSE  (99) 

RETURN 

CONTINUE 

WRITE (6,*)  'STOPPING  IN  LOADBM.  OPEN  FAILED  ON  ', FILNAM 
STOP  'STOPPING  IN  LOADBM,  OPEN  FAILED  ON  B-MATRIX.' 

END 
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REAL  function  TCONV2 (YR, DD, STRTYR, STRTDD)  MSM59450 
C  MSM59460 
C  THIS  FUNCTION  TAKES  A  START  YEAR,  START  DECIMAL  DAY,  MSM59470 
C  A  CURRENT  YEAR,  AND  A  CURRENT  DECIMAL  DAY.  IT  PRODUCES  MSM59480 
C  A  VALUE  THAT  IS  THE  SECONDS  FROM  THE  START  YEAR  AND  DAY.  MSM59490 
C  THIS  VALUE  IS  RELATIVE  TO  MIDNIGHT  OF  THE  START  DAY.  MSM59500 
C  MSM59510 


I 

I 


ooo  no  o  ooooonooo 


msml.for 


INTRINSIC  INT  MSM59520 

MSM59530 

TEMP  -  0.0  MSM59540 

MSM59550 

IF  (STRTYR.EQ.YR)  THEN  MSM59560 

TEMP  -  (DD  -  INT(STRTDD))  »  86400.0  MSM59570 

ELSEIF  (MOD (INT (STRTYR) , 4) .EQ. 0)  THEN  MSM59580 

TEMP  -  (DD  +  366.0  -  INT(STRTDD))  •  86400.0  MSM59590 

ELSE  MSM59600 

TEMP  -  (DD  +  365.0  -  INT(STRTDD))  *  86400.0  MSM59610 

ENDIF  MSM59620 

MSM59630 

TCONV2  -  TEMP  MSM59640 

MSM59650 

RETURN  MSM59660 

END  MSM59670 

MSM59680 

******************************  TCONV3  ****************************** *MSM5 9690 

MSM59700 

REAL  FUNCTION  TCONV3 (ITIME, ISTART)  MSM59710 

MSM59720 

THIS  FUNCTION  TAKES  A  START  YEAR,  START  DAY,  A  CURRENT  YEAR,  MSM59730 

A  CURRENT  DAY,  AND  A  CURRENT  SECOND..  IT  PRODUCES  MSM59740 

A  VALUE  THAT  IS  THE  SECONDS  FROM  THE  START  YEAR  AND  DAY.  MSM59750 

THIS  VALUE  IS  RELATIVE  TO  MIDNIGHT  OF  THE  START  DAY.  MSM59760 

MSM59770 

PARAMETER  ( IYR=1 , IDY=2 , ISEC=3 )  MSM59780 

DIMENSION  ITIME (3) , ISTART (3)  MSM59790 

INTRINSIC  REAL  MSM59800 

MSM59810 

IF  (ISTART (lYR) .EQ. ITIME (lYR))  THEN  MSM59820 

TEMP  -  REAL (ITIME (IDY)  -  ISTART (IDY) ) *86400 . 0  +  MSM59830 

1  REAL (ITIME (ISEC) )  MSM59840 

ELSEIF  (MOD (ISTART (lYR) , 4) .EQ. 0)  THEN  MSM59850 

TEMP  =  REAL (ITIME (IDY)  +  366  -  ISTART (IDY) ) *86400 . 0  +  MSM59860 

1  REALdTIMEdSEC)  )  MSM59870 

ELSE  MSM59880 

TEMP  =  REAL (ITIME (IDY)  +  365  -  ISTART (IDY) )* 86400 . 0  +  MSM59890 

1  REALdTIMEdSEC))  MSM59900 

ENDIF  MSM59910 

MSM59920 

TCONV3  «  TEMP  MSM59930 

MSM59940 

RETURN  MSM59950 

END  MSM59960 

MSM59970 

****************************  SMOOTH  ******************************  MSM59980 

MSM59990 

SUBROUT I NE  SMOOTH ( DARRY , ND I M , NUMNUM, START Y , S  TARTD ,  NA ,  XA ,  YA , I ERR )  MSM6  0000 
DIMENSION  DARRY(7,NDIM) ,XA(NDIM) ,YA(NDIM)  MSM60010 

REAL  STARTY, STARTD  MSM60020 

INTEGER  NUMNUM, NDIM, NA, lERR  MSM60030 

MSM60040 

EXTERNAL  TCONV2  MSM60050 

MSM60060 

This  routine  chec)cs  and  extracts  data  from  DARRY()  into  XA  ( )  ,  YA  ( )  .  MSM60070 
September  10,  1989  A)cira  NAGAI  MSM60080 

MSM60090 

INPUTS:  MSM60100 

DARRY 0  :  Source  data  MSM60110 

NDIM  :  A  Dimension  of  DARRY ()  MSM60120 

NUMNUM  :  Number  of  source  data  MSM60130 

STARTY,  STARTD  :  Start  year  and  day  MSM60140 

OUTPUTS:  MSM60150 


THIS  FUNCTION  TAKES  A  START  YEAR,  START  DAY,  A  CURRENT  YEAR, 

A  CURRENT  DAY,  AND  A  CURRENT  SECOND..  IT  PRODUCES 
A  VALUE  THAT  IS  THE  SECONDS  FROM  THE  START  YEAR  AND  DAY. 

THIS  VALUE  IS  RELATIVE  TO  MIDNIGHT  OF  THE  START  DAY. 

PARAMETER  (IYR=1 , IDY=2 , ISEC=3 ) 

DIMENSION  ITIME (3) , ISTART (3) 

INTRINSIC  REAL 

IF  (ISTARTdYR)  .EQ.  ITIME  (lYR))  THEN 

TEMP  -  REAL (ITIME (IDY)  -  ISTART (IDY) ) *86400 . 0  + 

1  REALdTIMEdSEC)) 

ELSEIF  (MOD  (ISTARTdYR)  ,4)  .EQ.O)  THEN 

TEMP  =  REAL (ITIME (IDY)  +  366  -  ISTART (IDY) ) *86400 . 0  + 

1  REALdTIMEdSEC)) 

ELSE 

TEMP  =  REAL (ITIME (IDY)  +  365  -  ISTART (IDY) )* 86400 . 0  + 

1  REALdTIMEdSEC)) 

ENDIF 

TCONV3  «  TEMP 
RETURN 


o  o  o 
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C  NA,XA(),YA()  :  #  of  valid  data  and  valid  data  pairs 

C  lERP  :  ERROR  CODE 

C 

C  September  10,  1989 

C 

C  Time  conversion 

DO  5,I-1,NUMNUM 

XA(I)  -  TCONV2 (DARRY(2, I) .DARRY (3, I)  ,  STARTY,  STARTD) 

C  WRITE  (6,*)  'SMOOTH  — ',DARRY(2,I),DARRY{3,I),STARTD,XA(I) 

YA(I)  -  DARRY(1,I) 

5  CONTINUE 

NA  -  NUMNUM 

C  Check  Time-tag.  Shift-up  if  same. 

IERR=0 

I-O 

10  CONTINUE 

I-I  +  l 

IF  (I.GE.NA)  RETURN 
IF  (XA(I) .GT.XA(I+1) )  THEN 

WRITE (6,*)  'SERIOUS  ERROR:  TIME-TAG  REVERSE  ORDER  IN  DARRY ( ) ' 
WRITE(6,*)  'X(I)  -  ',XA(I),'  X(I+1)  =  ',XA(I+1),'  I  =  ',I 

lERR  -  -1 
RETURN 
ELSE 

IF  (XA(I) .EQ.XA(I+1) )  THEN 

WRITE (6,*)  'WARNING:  SAME  TIME-TAG  EXISTS  IN  DARRY (). ' 

WRITE ( 6, * )  ' SECOND  DATA  IGNORED . ' 

DO  20,K-I+1,NA-1 
XA(K)-XA(K+1) 

YA(K)>=YA(K+1) 

20  CONTINUE 

NA  -  NA  -  1 
I  -  I  -  1 
END  IF 
END  IF 
GOTO  10 
END 

****************************  DTNTRP  ******************************* 

SUBROUTINE  DTNTRP (X, NA, XA, YA, Y, DYDX, DELTA, lERR) 

INTEGER  NA, lERR, I 

REAL  X,XA(*) ,YA(*) ,XD,y,DYDX,DELTA 
C 

C  This  function  returns  interpolation  values  for  the 

C  N  data  pairs  of  (XA (i) , YA (i ) )  ,  where  i=l..NA. 

C 

C  INPUTS: 

C  X  :  Given  value  of  X 

C  NA  :  Number  of  data  points. 

C  XA  :  Data  XA(1)  to  XA(NA) 

C  YA  :  Data  YA(1)  to  YA(NA) 

C 

C  OUTPUTS : 

C  Y  :  Interpolated  value  of  Y. 

C  DYDX:  Interpolated  value  of  dY/dX. 

C  DELTA  :  Gap  of  X. 

C  lERR:  Error  code. 

C 

C  September  08,  1989 

C 

IF  (X.GE.XA(NA) )  THEN 
IERR=-1 
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IF  (X.EQ.XA (NA) )  IERR-0 

Y  -  YA(NA) 

DYDX  »  (  yA(NA) -YA(NA-l)  )  /  (  XA (NA) -XA (NA-1 )  ) 

DELTA  -  X  -  XA(NA) 

ELSE  IF  (X.LT.XA(l))  THEN 
lERR— 1 
y  -  YA(1) 

DYDX  -  (  YA(2)-YA(1)  )  /  (  XA(2)-XA(1)  ) 

DELTA  =  XA(1)  -  X 
ELSE 

Scan  to  find  the  position  of  X. 

Maybe  binary  search  would  be  better. 

I  -  NA 
CONTINUE 

XD  »  X  -  XA(I) 

IF  (XD.GT.0.0)  GOTO  20 
I  -  I  -  1 
GOTO  10 

CONTINUE 
lERR  =  0 

DELTA2-  XA(I+1)-XA(I) 

DELTA  =  MIN(X-XA(I) ,XA(I+1) -X) 

DYDX  -  (YA (I H) -YA (I) )  /  DELTA2 

Y  -  DYDX  »  XD  +  YAd) 

END  IF 

RETURN 

END 


*****************************  dtxipt  **************************** 

SUBROUTINE  DTXIPT (X, NA, XA, YA, Y, DYDX, DELTA, lERR) 

INTEGER  NA, lERR, I 

REAL  X,XA(*) ,YA(*) ,XD,Y, DYDX, DELTA 
C 

C  This  function  returns  interpolation  values  for  XIPATT 

C 

C  INPUTS : 

C  X  ;  Given  value  of  X 

C  NA  :  Number  of  data  points. 

C  XA  ;  Data  XA(1)  to  XA(NA) 

C  YA  :  Data  YA(1)  to  YA(NA) 

C 

C  OUTPUTS : 

C  y  :  Interpolated  value  of  Y. 

C  DYDX:  Interpolated  value  of  dY/dX. 

C  DELTA  :  Gap  of  X. 

C  lERR:  Error  code. 

C 

C  September  08,  1989 

C 

IF  (X.GT.XA(NA) )  THEN 
IERR=-1 

IF  (X.EQ.XA(NA) )  IERR=0 

Y  =  YA(NA) 

DELTA  =  X  -  XA(NA) 

ELSE  IF  (X.LE.XA(l))  THEN 
IERR=-1 

IF  (X.EQ.XA(l))  IERR=0 

Y  =  YA(1) 

DELTA  »  XA(1)  -  X 
ELSE 


MSM60800 

MSM60810 

MSM60820 

MSM60830 

MSM60840 

MSM60850 

MSM60860 

MSM60870 

MSM60880 

MSM60890 

MSM60900 

MSM60910 

MSM60920 

MSM60930 

MSM60940 

MSM60950 

MSM60960 

MSM60970 

MSM60980 

MSM60990 

MSM61000 

MSM61010 

MSM61020 

MSM61030 

MSM61040 

MSM61050 

MSM61060 

MSM61070 

MSM61080 

MSM61090 

MSM61100 

MSM61110 

MSM61120 

MSM61130 

MSM61140 

MSM61150 

MSM61160 

MSM61170 

MSM61180 

MSM61190 

MSM61200 

MSM61210 

MSM61220 

MSM61230 

MSM61240 

MSM61250 

MSM61260 

MSM61270 

MSM61280 

MSM61290 

MSM61300 

MSM61310 

MSM61320 

MSM61330 

MSM61340 

MSM61350 

MSM61360 

MSM61370 

MSM61380 

MSM61390 

MSM61400 

MSM61410 

MSM61420 

MSM61430 


msml.for 


C  Scan  to  find  the  position  of  X. 

I  =  NA 

10  CONTINUE 

XD  =  X  -  XA(I) 

IF  (XD.GE.0.0)  GOTO  20 
1  =  1-1 
GOTO  10 

20  CONTINUE 

lERR  =  0 

DELTA  =  MIN(X-XA(I) ,XA(I+1) -X) 
A=X-XA(I) 

B=XA(I+1) -X 

IF  (A.LT.B)  THEN 
y  -  YA(I) 

ELSE 

Y  =  YA(I+1) 

END  IF 
ENDIF 


RETURN 
END 

C************************************************ *******  STDOFF 

C 

SUBROUTINE  STNDOF (VELOC,DENS, STAND) 

C 

ANALYTIC  CALCULATION  OF  THE  STAND-OFF  DISTANCE  *  MSM61720 

MSM61730 

FORMULA  ACCORD.  TO  ALP BACH  -  PAPER  (1979) 


MSM61440 

MSM61450 

MSM61460 

MSM61470 

MSM61480 

MSM61490 

MSM61500 

MSM61510 

MSM61520 

MSM61530 

MSM61540 

MSM61550 

MSM61560 

MSM61570 

MSM61580 

MSM61590 

MSM61600 

MSM61610 

MSM61620 

MSM61630 

MSM61640 

MSM61650 

MSM61660 

MSM61670 

****MSM61680 

MSM61690 

MSM61700 

MSM61710 


MSM61740 
MSM61750 

BO  =  MAGNETIC  FIELD  AT  THE  EQUATOR  IN  (GAUSS)  MSM61760 

FAK  =  REFLECTION  FACTOR  FOR  SOLAR-WIND  PATICLES  MSM61770 

F  =  GEOMETRY  FAKTOR  OF  THE  MAGNETOPAUSE  MSM61780 

PSOL  =  SOLARWIND-PRESS  IN  (l.E-08  DYN/(CM**2))  MSM61790 

PEFF  =  SOLARWIND-PRESS  IN  {l.E-16  DYN/ (CM**2)  MSM61800 

MSM61810 
MSM61820 
MSM61830 
MSM61840 
MSM61850 

BSTAG  MAGNETIC  FIELD  AT  SUBSOLAR  POINT  IN  [MSM61860 
STAND  STAND  OFF  DISTANCE  IN  [EARTH  RADII]  MSM61870 

MSM61880 


VELOC  SOL  WIND  VELOCITY  IN  [KM/ SEC] 
DENS  SOL  WIND  DESITY  IN  [1/CM]**3 


C  *  *  *  INPUT  PARAMTERS: 

C 
C 

C  *  *  *  OUTPUT  PARAMETERS 
C 
C 
C 

C  *  *  CALCULATION  OF  HELIUM  PERCENTAGE  IN  THE  SOLAR  WIND 
C 

C  HELIUM  =  HELIUM-PROZENT 
C 

HELIUM  =0.00 


if  ic  i(  It  if 


PERCl 

PERC2 


HELIUM/100. 
1.0  -  PERCl 


C 

C 

C 


DENGES  -  DENS  *  (PERC2  +  4.*PERC1) 
VO  -  VELOC 
FAK  -  1.0 

PROTMA  -  1.6726  *  l.E-24 
VAU  -  VO  *  l.E+05 
PI  -  ACOS (-1.00000) 


MSM61890 

MSM61900 

MSM61910 

MSM61920 

MSM61930 

MSM61940 

MSM61950 

MSM61960 

MSM61970 

MSM61980 

MSM61990 

MSM62000 

MSM62010 

MSM62020 

MSM62030 

MSM62040 

MSM62050 

MSM62060 

MSM62070 


o  o 


C 

C 


C 

C 


C 

C 

C  * 

c 

c 

c 


c 

c 


DRUCK 

DRUCK 

DRUCK 


8.*PI  *  FAK  *  DENGES 
DRUCK  *  l.E+10 
SQRT (DRUCK) 


msml.for 

*  PROTMA  *  VAU 


VAU 


FELD  -  DRUCK 

PSOL  -  DRUCK  *  l.E-05 
PSOL  -  PSOL  *  PSOL 
PSOL  -  PSOL/ (8.*PI) 
PSOL  -  PSOL  *  l.E+08 


PI  -  ACOS (-1 . 00000) 

BO  »  0.23 
BO  =  0.311829 

PGES  =  PSOL  *  (PERC2  +  4.*PERC1) 


*  IN  THIS  SPECIAL  VERSION  OF  THE  ROUTINE  STDOFF,  THE  MAGNETOSPHERE 

ASSUMED  TO  BE  COMPLETELY  CLOSED. 


BZIMF 

=  0.00 

CD 

=  0.00 

CIMF 

-  0.00 

BZIMF 

=  BZIMF  *  l.E-05 

F  -  1 

.16000 

FAK  “ 

1.0 

FQK  = 

F  *  F  /  FAK 

PEFF 

=  2.*PI  *  PGES  *  l.E 

EX 

=  1./6. 

RO  = 

(FQK  *  B0*B0* (1 . -CD) 

RO  = 

RO  *  (1.  +  (EX*CIMF* 

FELD 

-  PGES  *  1.E-08 

FELD 

=  FELD  *  8.*PI 

FELD 

=  SQRT (FELD) 

FELD 

=  FELD  *  1.E+05 

BSTAG 

;  =  FELD 

STAND 

-  RO 

RETURN 

END 

SUBROUTINE  FLXNIT (IRDIM, NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXR, 
2  FLXNRG, FLXKP,FLXMAT,THRMAT) 


C 

C 

C 

C 

C 

C 

C 


VERSION  1.00 


DATE:  10.04.89 


PURPOSE:  SUBROUTINE  TO  CALCULATE  KP-BASED  PARTICLE  NUMBER  FLUX 

IN  UNITS  OF  PARTICLES/CM* *2/S/SR/EV  AS  FCN  OF  R,  ENERGY, 
AND  KP. 

DIMENSION  FLXMAT (IRDIM, NRGDIM, KPPLUS, ISPDIM) 

DIMENSION  THRMAT (IRDIM, NRGDIM, KPDIM) 

DIMENSION  FLXR ( IRDIM) , FLXNRG (NRGDIM) ,FLXKP (KPDIM) 

DIMENSION  THR(4) 


MSM62080 

MSM62090 

MSM62100 

MSM62110 

MSM62120 

MSM62130 

MSM62140 

MSM62150 

MSM62160 

MSM62170 

MSM62180 

MSM62190 

MSM62200 

MSM62210 

MSM62220 

MSM62230 

MSM62240 

MSM62250 

MSM62260 

IMSM62270 

MSM62280 

MSM62290 

MSM62300 

MSM62310 

MSM62320 

MSM62330 

MSM62340 

MSM62350 

MSM62360 

MSM62370 

MSM62380 

MSM62390 

MSM62400 

MSM62410 

MSM62420 

MSM62430 

MSM62440 

MSM62450 

MSM62460 

MSM62470 

MSM62480 

MSM62490 

MSM62500 

MSM62510 

MSM62520 

MSM62530 

MSM62540 

MSM62550 

MSM62560 

MSM62570 

MSM62580 

MSM62590 

MSM62600 

MSM62610 

MSM62620 

MSM62630 

MSM62640 

MSM62650 

MSM62660 

MSM62670 

MSM62680 

MSM62690 

MSM62700 

MSM62710 


»« 


ooo  o  oooo  o  oo 


msml.for 


MSM62720 

DO 

10  IKP=1,KPDIM 

MSM62730 

FLXKP (IKP) “FLOAT (IKP-1) 

MSM62740 

10 

CONTINUE 

MSM62750 

MSM62760 

DO 

20  INRG=1 , NRGDIM 

MSM62770 

FLXNRG(INRG) “FLOAT (INRG+3) /4 . 

MSM62780 

20 

CONTINUE 

MSM62790 

MSM62800 

FLXR(1)=ALOG10 (3. ) 

MSM62810 

FLXR(2)-ALOG10(4.) 

MSM62820 

FLXR(3)=ALOG10 (6.6) 

MSM62830 

FLXR(4)=ALOG10 (13.  ) 

MSM62840 

MSM62850 

MSM62860 

DO 

90  ISP“1,ISPDIM 

MSM62870 

ISPP“ISP 

MSM62880 

DO  100  IKP=1,KPDIM 

MSM62890 

DO  110  INRG=1, NRGDIM 

MSM62900 

CALL  FLXCALdSPDIM,  KPDIM,ISPP,  FLXKP  (IKP)  ,  FLXNRG  (INRG)  , 

MSM62910 

2 

FLX3 , FLX4 , FLX6 , FLXl 3 ) 

MSM62920 

DO  120  IR=1,IRDIM 

MSM62930 

FLXMATdR,  INRG,  IKP,  ISP)=FLXTRP  (FLXRCIR)  ,FLX3,FLX4, 

MSM62940 

2 

FLX6,FLX13) 

MSM62950 

120 

CONTINUE 

MSM62960 

110 

CONTINUE 

MSM62970 

100 

CONTINUE 

MSM62980 

90 

CONTINUE 

MSM62990 

MSM63000 

DO 

200  IKP“1,KPDIM 

MSM63010 

IIKP=IKP 

MSM63020 

DO  210  INRG“1, NRGDIM 

MSM63030 

IINRG“INRG 

MSM63040 

CALL  THRCAL (FLXKP (IKP) , FLXNRG (INRG) , IINRG, IIKP, IRDIM, 

MSM63050 

2 

NRGDIM, KPDIM, KPPLUS, ISPDIM, FLXMAT, THR) 

MSM63060 

DO  220  IR=1, IRDIM 

MSM63070 

THRMAT (IR, INRG, IKP) “THR (IR) 

MSM63080 

220 

CONTINUE 

MSM63090 

210 

CONTINUE 

MSM63100 

200 

CONTINUE 

MSM63110 

MSM63120 

CYCLE 

THROUGH  KP  VALUES  AND  PUT  MIN  FLUX  IN  KPDIM+1 

MSM63130 

MAX  FLUX  IN  KPDIM+2 

MSM63140 

MSM63150 

DO 

300  ISP“1, ISPDIM 

MSM63160 

DO  310  INRG=1, NRGDIM 

MSM63170 

DO  320  IR=1, IRDIM 

MSM63180 

FLXMIN=1.E20 

MSM63190 

FLXMAX=-1.E20 

MSM63200 

DO  330  IKP=1, KPDIM 

MSM63210 

FLXMIN=MIN  (FLXMATdR,  INRG,  IKP,  ISP)  ,FLXMIN) 

MSM63220 

FLXMAX=MAX (FLXMAT (IR, INRG, IKP, ISP) , FLXMAX) 

MSM63230 

330 

CONTINUE 

MSM63240 

MSM63250 

FLXMAT (IR, INRG, KPDIM+1 , ISP) “FLXMIN 

MSM63260 

FLXMAT (IR, INRG, KPDIM+2, ISP) “FLXMAX 

MSM63270 

320 

CONTINUE 

MSM63280 

310 

CONTINUE 

MSM63290 

300 

CONTINUE 

MSM63300 

MSM63310 

MSM63320 

MSM63330 

RETURN 

MSM63340 

END 

MSM63350 

msml.for 

SUBROUTINE  FLXCAL ( 1 SPDIM, KPDIM, I SPP , FKP , FNRGLG, FLX3 , FLX4 , FLX6 , 

FLX13) 


VERSION  1.00 


DATE:  05.02.90 


PURPOSE:  COMPUTE  KP-DEPENDENT  FLUX  (PARTICLES/CM**2/S/SR/EV)  AT 
L“3,  4,  6.6,  AND  13  FOR  ELECTRONS  OR  IONS  OF  ENERGY 
FNRG  (EV)  AND  FOR  KP=FKP  CONDITIONS.  ISPP  GIVES  THE 
MASS  SPECIES  OF  THE  FLUX  TO  BE  CALCULATED. 

IF  ISPP»=1  THEN  ELECTRON  FLUX  VALUES  ARE  RETURNED 
IF  ISPP=2  THEN  H+  FLUX  VALUES  ARE  RETURNED 
IF  ISPP=3  THEN  0+  FLUX  VALUES  ARE  RETURNED 


REF:  SECTION  2 . 5  OF  THE  FINAL  REPORT  FOR 
CONTRACT  #F19628-87-K-0001 

PARAMETER  (ISPSIZ=3, IKPSIZ=7, KAPSIZ=2) 

PARAMETER (NKPSIZ=3,NSPSIZ=2) 

DIMENSION  DENGEO(KAPSIZ, IKPSIZ) , EGEO (KAPSIZ, IKPSIZ) 

DIMENSION  DIONG (KAPSIZ, IKPSIZ) , EIONG (KAPSIZ, IKPSIZ) 

DIMENSION  DEN4 (NKPSIZ, KAPSIZ, NSPSIZ) , DEN3 (NKPSIZ, KAPSIZ, NSPSIZ) 
DIMENSION  EZ43 (NKPSIZ, KAPSIZ, NSPSIZ) , RKAP43 (NKPSIZ, KAPSIZ, NSPSIZ) 
DIMENSION  FKAP43 (NKPSIZ, KAPSIZ, NSPSIZ) , FLX43 (NKPSIZ) 


DATA  DENGEO  /O. 5697,  .004926,  0 , 6034, .2261,  0.6292,  .2583, 

2  0.7002,  .3418,  0.8135,  .4602,  1.0347,  .6446, 

3  1.4468,  .8505/ 

DATA  EGEO  /31.036,  21000.,  40.803,  4832.4,  48.670,  4814.0, 

2  71.680,  4797.8,  111.119,  4816.0,  192.704,4894.3, 

3  342.712,  5075.2/ 

DATA  DIONG  /O . 602, 0 . 460 , 0 . 661, 0 . 457, 

2  0.712,0.495,0.813,0.524, 

3  0.966,0.539,0.700,0.517, 

4  1.652,0.453/ 

DATA  EIONG  /  180.2,25408.,  258.4,26837., 

2  335.4,27902.,  604.8,30723., 

3  1144.2,34972.,  2315.4,42809., 

4  4182.4,57163./ 

DATA  DEN4/0. 10, 0.20, 0.00,0.375,1.90,2.30, 

2  0.43,0.18,0.00,0.00,1.50,5.00/ 

DATA  DEN3/0. 032, 0.06, 0.00, 0.12, 0.60, 6. 30, 

2  0.06,0.018,0.0,0.00,0.15,11.8/ 

DATA  E243/3. 00, 15.0, 15 . 00, 200 . , 4 0 . 0, 60 . 0, 

2  5.00,5.00,5.00,20.0,20.0,30.0/ 

DATA  FKAP43/. 9359421, .9619483, .9619483, 

2  .9619483, .9359421, .9619483, 

3  .9027036, .9619483, .9619483, 

4  .9359421, .9359421, .9619483/ 

DATA  RKAP43/6.00,10.0,10.00,10.0,6.00,10.0, 

2  4.00,10.0,10.00, 6.00,6.00,10.0/ 


MSM63360 

MSM63370 

MSM63380 

MSM63390 

MSM63400 

MSM63410 

MSM63420 

MSM63430 

MSM63440 

MSM63450 

MSM63460 

MSM63470 

MSM63480 

MSM63490 

MSM63500 

MSM63510 

MSM63520 

MSM63530 

MSM63540 

MSM63550 

MSM63560 

MSM63570 

MSM63580 

MSM63590 

MSM63600 

MSM63610 

MSM63620 

MSM63630 

MSM63640 

MSM63650 

MSM63660 

MSM63670 

MSM63680 

MSM63690 

MSM63700 

MSM63710 

MSM63720 

MSM63730 

MSM63740 

MSM63750 

MSM63760 

MSM63770 

MSM63780 

MSM63790 

MSM63800 

MSM63810 

MSM63820 

MSM63830 

MSM63840 

MSM63850 

MSM63860 

MSM63870 

MSM63880 

MSM63890 

MSM63900 

MSM63910 

MSM63920 

MSM63930 

MSM63940 

MSM63950 

MSM63960 

MSM63970 

MSM63980 

MSM63990 


ooo  oooo  ooo  o  ooo  ooo  oo 


msml.for 

IF(ISPSIZ.NE.ISPDIM)  THEN 

WRITE (6,*)  'DIMENSION  ERROR  IN  SUBROUTINE  FLXNIT' 

WRITE (6,*)  'ISPSIZ  IS  NOT  EQUAL  TO  ISPDIM' 

WRITE (6, *)  ' ISPSIZ=' , ISPSIZ, ' ISPD1M=' , ISPDIM 
WRITE (6,*)  'STOPPING  PROGRAM  IN  FLXNIT' 

STOP 
END  IF 
C 

IF(IKPSIZ.NE.KPDIM)  THEN 

WRITE (6,*)  'DIMENSION  ERROR  IN  SUBROUTINE  FLXNIT' 

WRITE (6,*)  'IKPSIZ  IS  NOT  EQUAL  TO  KPDIM' 

WRITE (6, *)  ' IKPSIZ=' , ISPSIZ, 'KPDIM=' , KPDIM 
WRITE (6,*)  'STOPPING  PROGRAM  IN  FLXNIT' 

STOP 
END  IF 
C 

FNRG=10.**FNRGLG 

C 

IF(ISPP.EQ.l)  THEN 

C  CALCULATE  ELECTRON  FLUX  VALUES 

RKAP=6. 

FKAP'. 9359421 

CALCULATE  PLASMA  SHEET  FLUX,  FLX13 

DENSTY=(.4* (FKP-1. )+0.5* (5.-FKP) ) /4. 

EZERO=.2885* (FKP-1 .)+. 15625* (5.-FKP) 

FLX13*1.68E5*FKAP*DENSTY* (FNRG*1 . E-3/EZERO) /SQRT(EZERO) / 
2  (1.+ (FNRG*l.E-3) /RKAP/EZERO) ** (RKAP+1. ) 


CALCULATE  GEOSYNCHRONOUS  FLUX,  FLX6 
IKP»=NINT(FKP+1. ) 

FLX6=0, 

DO  10  N=l,2 

WRITE (6,*)  'IKP=',IKP,'  N=',N, '  FNRG=',FNRG 

WRITE (6,*)  'DENSITY=',DENGEO(N, IKP),'  EZERO=' , EGEO (N, IKP) 

WRITE (6,*)  'FKAP=' ,FKAP, '  RKAP=',RKAP 

FLX6=FLX6+1 . 68E5*FKAP*DENGEO (N, IKP) * (FNRG/EGEO (N, IKP) ) / 

2  SQRT (EGEO (N, IKP) *1. E-3) / 

3  (l.+MIN(FNRG/RKAP/EGEO(N, IKP) , 1.E5) ) ** (RKAP+1. ) 

WRITE (6,*)  'FLX6=',FLX6 

10  CONTINUE 


CALCULATE  FLUX  AT  L=4,  FLX4 

FLX4=1.106E1* (FNRG*l.E-3) * (10.** ( (FKP-2. ) /6. )  ) / 
2  (l.+FNRG*l.E-3/32. ) **3 

WRITE (6,*)  'FLX4=',FLX4 


CALCULATE  FLUX  AT  L=3,  FLX3 

FLX3=4.795E0* (FNRG*l.E-3) * (10.** ( (FKP-2. ) /6. ) ) / 
2  (l.+FNRG*l.E-3/65.8)**3.8 


ELSE 

C  CALCULATE  H+  OR  0+  FLUXES 

C 

c 

C  PLASMA  SHEET  FLUX,  FLX13 

DENSTY-(.4* (FKP-1. )+0.5* (5.-FKP) ) /4. 
EZERO-2.25* (FKP-1 . ) +1.219* (5 . -FKP) 

C  EZERO  IN  KEV 


MSM64020 

MSM64030 

MSM64040 

MSM64050 

MSM64060 

MSM64070 

MSM64080 

MSM64090 

MSM64100 

MSM64110 

MSM64120 

MSM64130 

MSM6414C 

MSM64150 

MSM64160 

MSM64170 

MSM64180 

MSM64190 

MSM64200 

MSM64210 

MSM64220 

MSM64230 

MSM64240 

MSM64250 

MSM64260 

MSM64270 

MSM64280 

MSM64290 

MSM64300 

MSM64310 

MSM64320 

MSM64330 

MSM64340 

MSM64350 

MSM64360 

MSM64370 

MSM64380 

MSM64390 

MSM64400 

MSM64410 

MSM64420 

MSM64430 

MSM64440 

MSM64450 

MSM64460 

MSM64470 

MSM64480 

MSM64490 

MSM64500 

MSM64510 

MSM64520 

MSM64530 

MSM64540 

MSM64550 

MSM64560 

MSM64570 

MSM64580 

MSM64590 

MSM64600 

MSM64610 

MSM64620 

MSM64630 


msml.for 

RKAP“6. 

FKAP-. 9359421 
C 

IF(FKP.GE.l.)  THEN 

RATOH=(0.6* (FKP-1.)+0.06* (5.-FKP) )/4. 

ELSE 

RATOH=0.06 
END  IF 
C 

IF  (ISPP.EQ.2)  THEN 

DENION=DENSTY/ (l.+RATOH) 

AWT-1 . 

ELSE 

DENION=DENSTY*RATOH/ (l.+RATOH) 

AWT-16. 

END  IF 
C 

FLX13=3.93E3*FKAP*DENION* (FNRG*1 .E-3/EZERO) /SQRT (AWT*EZERO) / 
2  (1 .+ (FNRG*1 .E-3) /RKAP/EZERO) ** (RKAP+1. ) 

C 

C 

C  CALCULATE  GEOSYNCHRONOUS  ION  FLUX,  FLX6 
RKAPl-10. 

RKAP2=4. 

FKAP1=. 96194826 
FKAP2=. 9027036 
C 

RATOH1=(0.7+ (FKP-l.)+0.4* (5.-FKP))/4. 

C 

IF(FKP,GE.l.)  THEN 

RATOH2=(0.154* (5 . -FKP) +0 . 767* (FKP-1 . )  )  /4. 

ELSE 

RATOH2=0.154 
END  IF 
C 

IKP-NINT(FKP+1.) 

FLX6=0. 

C 

DO  20  N=l,2 
C 

IF(N.EQ.l)  THEN 
RKAP=RKAP1 
FKAP=FKAP1 
RATOH=RATOHl 
ELSE 

RKAP=RKAP2 
FKAP=FKAP2 
RATOH=RATOH2 
END  IF 
C 

IF (ISPP.EQ.2)  THEN 
C  H+  IONS 

DENION=DIONG (N, IKP) / (l.+RATOH) 

AWT-1 , 

ELSE 

C  0+  IONS 

DENION=DIONG(N, IKP) *RATOH/ (l.+RATOH) 

AWT=16. 

END  IF 
C 

FLX6-FLX6+3. 93E3*FKAP*DENION* (FNRG/EIONG (N, IKP) ) / 

2  SQRT (AWT*EIONG(N, IKP) *1. E-3) / 

3  (l.+FNRG/RKAP/EIONG(N,IKP) ) ** (RKAP+1. ) 

C 


MSM64640 

MSM64650 

MSM64660 

MSM64670 

MSM64680 

MSM64690 

MSM64700 

MSM64710 

MSM64720 

MSM64730 

MSM64740 

MSM64750 

MSM64760 

MSM64770 

MSM64780 

MSM64790 

MSM64800 

MSM64810 

MSM64820 

MSM64830 

MSM64840 

MSM64850 

MSM64860 

MSM64870 

MSM64880 

MSM64890 

MSM64900 

MSM64910 

MSM64920 

MSM64930 

MSM64940 

MSM64950 

MSM64960 

MSM64970 

MSM64980 

MSM64990 

MSM65000 

MSM65010 

MSM65020 

MSM65030 

MSM65040 

MSM65050 

MSM65060 

MSM65070 

MSM65080 

MSM65090 

MSM65100 

MSM65110 

MSM65120 

MSM65130 

MSM65140 

MSM65150 

MSM65160 

MSM65170 

MSM65180 

MSM65190 

MSM65200 

MSM65210 

MSM65220 

MSM65230 

MSM65240 

MSM65250 

MSM65260 

MSM65270 
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20  CONTINUE 


CALCULATE  ION  FLUX  AT  L=4,  FLX4 

NOTE:  THIS  ALGORITHM  IS  A  LITTLE  WASTEFUL  OF  TIME  IN  THE  INTEREST 
OF  SAVING  PROGRAM  COMPLEXITY. 

ISPNDX=ISPP-1 
DO  30  NKP=1,NKPSIZ 

NKP-1  IS  ASSOCIATED  WITH  KP=0 

NKP»2  IS  ASSOCIATED  WITH  KP=5+ 

nkp=3  is  associated  with  KP=9- 

FLX43(NKP)=0. 

DO  40  N=l,2 

FLX43 (NKP) =FLX43 (NKP) +3 . 93E3*FKAP43 {NKP,N, ISPNDX) * 

2  DEN4 (NKP, N, ISPNDX) * {FNRG*l.E-3/ 

3  EZ43 (NKP, N, ISPNDX) ) / 

4  SORT (AWT*EZ43 (NKP, N, ISPNDX))/ 

5  (l.+(FNRG*l.E-3) /RKAP4 3 (NKP, N, ISPNDX) / 

6  EZ43 (NKP,N, ISPNDX) ) ** (RKAP43 (NKP,N, ISPNDX) +1.) 

40  CONTINUE 

30  CONTINUE 

IF(FKP.LE.5.34)  THEN 

FLXLOG'ALOGIO (FLX43 (1) )+ALOG10 (FLX43 (2) /FLX43 (1) ) * 

2  (FKP/5.34) 

ELSE  IF(FKP.GT.5.34.AND.FKP.LE.8.67)  THEN 

FLXLOG=ALOG10 (FLX43 (2) ) +ALOG10 (FLX43 (3) /FLX43 (2) ) * 

2  ((FKP-5.34)/(8.67-5.34)) 

ELSE 

FLXLOG=ALOG10 (FLX43 (3)  ) 

END  IF 

FLX4=10,**FLXLOG 


CALCULATE  ION  FLUX  AT  L=3,  FLX3 

NOTE:  THIS  ALGORITHM  IS  A  LITTLE  WASTEFUL  OF  TIME  IN  THE  INTEREST 
OF  SAVING  PROGRAM  COMPLEXITY. 

ISPNDX=ISPP-1 
DO  50  NKP“1,NKPSIZ 

NKP-1  IS  ASSOCIATED  WITH  KP=0 
NKP-2  IS  ASSOCIATED  WITH  KP=5+ 

NKP-3  IS  ASSOCIATED  WITH  KP=9- 

FLX43 (NKP)=0. 

DO  60  N=l,2 

FLX43 (NKP) =FLX43 (NKP) +3 . 93E3*FKAP43 (NKP, N, ISPNDX) * 

2  DEN3 (NKP, N, ISPNDX) * (FNRG*1 .E-3/ 

3  EZ43 (NKP, N, ISPNDX) ) / 

4  SORT (AWT*EZ4 3 (NKP, N, ISPNDX) ) / 

5  (■ .+(FNRG*1.E-3)/RKAP43 (NKP, N, ISPNDX)/ 

6  EZ43 (NKP,N, ISPNDX) ) ** (RKAP43 (NKP,N, ISPNDX) +1 . ) 


MSM65280 

MSM65290 

MSM65300 

MSM65310 

MSM65320 

MSM65330 

MSM65340 

MSM65350 

MSM65360 

MSM65370 

MSM65380 

MSM65390 

MSM65400 

MSM65410 

MSM65420 

MSM65430 

MSM65440 

MSM65450 

MSM65460 

MSM65470 

MSM65480 

MSM65490 

MSM65500 

MSM65510 

MSM65520 

MSM65530 

MSM65540 

MSM65550 

MSM65560 

MSM65570 

MSM65580 

MSM65590 

MSM65600 

MSM65610 

MSM65620 

MSM65630 

MSM65640 

MSM65650 

MSM65660 

MSM65670 

MSM65680 

MSM65690 

MSM65700 

MSM65710 

MSM65720 

MSM65730 

MSM65740 

MSM65750 

MSM65760 

MSM65770 

MSM65780 

MSM65790 

MSM65800 

MSM65810 

MSM65e20 

MSM65830 

MSM65840 

MSM65850 

MSM65860 

MSM65870 

MSM65880 

MSM65890 

MSM65900 

MSM65910 
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non  ooooooooooo  oo  o  ooooooo  oo  oo 
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CONTINUE 


CONTINUE 


IF(FKP.LE.5.34)  THEN 

FLXLOG=ALOG10 (FLX43 (1) ) +ALOG10 (FLX43 (2) /FLX43 (1) ) * 

(FKP/5.34) 

ELSE  IF(FKP.GT.5.34.AND.FKP.LE.8.67)  THEN 

FLXLOG=ALOG10 (FLX43 (2) ) +ALOG10 (FLX43 (3) /FLX43 (2) ) * 

((FKP-5.34)/(8.67-5.34)) 

ELSE 

FLXLOG=ALOG10  <FLX43 (3) ) 

END  IF 

FLX3»10.**FLXLOG 


END  IF 


RETURN 

END 

FUNCTION  FLXTRP (RLOG, FLX3, FLX4 , FLX6, FLX13) 


VERSION  1.00 


DATE:  10.04.89 


PURPOSE:  FUNCTION  SUBPROGRAM  TO  RETURN  FLUX  VALUE  INTERPOLATED 
BETWEEN  VALUES  AT  L=3,  4,  6.6,  AND  13  RE. 


FR=10. **RLOG 
IF(FR.LE.4.)  THEN 

FLXLOG“(ALOG10 (FR/3. ) *ALOG10 (FLX4) +ALOG10 (4./FR) *ALOG10 (FLX3) ) 

2  /ALOG10(4./3.) 

ELSE  1F(FR.GT.4. .AND.FR.LE.6.6)  THEN 

FLXLOG= (ALOGIO (FR/4 . ) *ALOG10 (FLX6) +ALOG10 (6. 6/FR) *ALOG10 (FLX4) ) 
2  /ALOGIO (6.6/4. ) 

ELSE 

FLXLOG-ALOGIO (FLX13) +ALOG10 (13. /FR) 

END  IF 

FLXTRP=FLXLOG 


RETURN 

END 

FUNCTION  FLXVAL (ISP, FKP, RR, PP, ENRG, IRDIM, NRGDIM, KPDIM, KPPLUS, 
2  ISPDIM, FLXMAT, FLXR, FLXNRG, FLXKP) 


VERSION  1.00 


DATE:  05.08.90 
12.31.89 
05.30.90 


PURPOSE:  CALCULATE  KP-DEPENDENT  FLUX  VALUE  AT  R=RR,  FOR  PARTICLES  OF 
SPECIES  ISP,  OF  ENERGY  ENRG  AND  KP=FKP  CONDITIONS  BY 
INTERPOLATING  FLXMAT  ARRAY. 

PROGRAMMER:  R.W.  SPIRO 

DIMENSION  FLXMAT (IRDIM, NRGDIM, KPPLUS, ISPDIM) 

DIMENSION  FLXR (IRDIM) , FLXNRG (NRGDIM) , FLXKP (KPDIM) 

DETERMINE  INTERPOLATION  INDICES 


MSM65920 

MSM65930 

MSM65940 

MSM65950 

MSM65960 

MSM65970 

MSM65980 

MSM6S990 

MSM66000 

MSM66010 

MSM66020 

MSM66030 

MSM66040 

MSM66050 

MSM66060 

MSM66070 

MSM66080 

MSM66090 

MSM66100 

MSM66110 

MSM66120 

MSM66130 

MSM66140 

MSM66150 

MSM66160 

MSM66170 

MSM66180 

MSM66190 

MSM66200 

MSM66210 

MSM66220 

MSM66230 

MSM66240 

MSM66250 

MSM66260 

MSM66270 

MSM66280 

MSM66290 

MSM66300 

MSM66310 

MSM66320 

MSM66330 

MSM66340 

MSM66350 

MSM66360 

MSM66370 

MSM66380 

MSM66390 

MSM66400 

MSM66410 

MSM66420 

MSM66430 

MSM66440 

MSM66450 

MSM66460 

MSM66470 

MSM66480 

MSM66490 

MSM66500 

MSM66510 

MSM66520 

MSM66530 

MSM66540 

MSM66550 


oo  o  ooo  oo 
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IF(FKP.GE.O.)  THEN 
BKP=FKP+1 . 

IF (BKP . GT . FLOAT (KPDIM) )  BKP=FLOAT (KPDIM) 

ELSE 

BKP=ABS (FKP) 

END  IF 

BNRG=4 . *ALOG10 (ENRG) -3 . 

RLOG=ALOG10 (RR) 

IF(RLOG.GT.FLXR(IRDIM) )  THEN 
BR=IRDIM 

FLXL0G=G3NTRP (FLXMAT (1, 1, 1, ISP) , IRDIM, NRGDIM, KPPLUS, BR, BNRG, 

2  BKP)  +  ALOGIO {13./RR) 


DO  10  IR=1,IRDIM-1 

IF (RLOG.LE.FLXR(IR+l) )  THEN 

BR=FLOAT(IR)+ (RLOG-FLXR{IR) ) / (FLXR (IR+1 ) -FLXR (IR) ) 
GO  TO  20 
END  IF 
CONTINUE 


)  CONTINUE 

WRITE (6, *)  '  FKP, RR, ENRG' , FKP, RR, ENRG 
WRITE (6,*)  ' BKP, BR, BNRG' , BKP, BR, BNRG 

FLXLOG=G3NTRP (FLXMAT ( 1 , 1 , 1 , 1 SP ) , IRDIM, NRGDIM, KPPLUS ,  BR, BNRG, 

2  BKP) 

END  IF 

FLXVAL=10 . **FLXLOG 

WRITE (6,*)  '  FLXLOG=' ,FLXLOG, '  FLXVAL=' , FLXVAL 

RETURN 

END 

SUBROUTINE  EFIELD (KPATT, PCP, DEQDT, ASOUTH, BSOUTH, DXS, DYS, ANORTH, 

2  BNORTH, DXN, DYN, COLAT, ALOCT, MODE, LATDIM, LTDIM, 

3  JWRAP, ITMDIM, ITMCUR, ICNTRL, ITOP, V, VNORTH, 

4  VSOUTH) 


PURPOSE: 


NOTE: 


SUBROUTINE  TO  RETURN  VALUES  OF  THE  POTENTIAL  ON  THE 
NORTHERN  HEMISPHERE  GRID  (VNORTH) ,  ON  THE  SOUTHERN 
HEMISPHERE  GRID  (VSOUTH) ,  AND  THE  AVERAGE  OF  THE  TWO 
HEMISPHERES  (V) .  THE  POTENTIAL  DISTRIBUTION  GIVEN  BY 
V  IS  THE  ACTUAL  DISTRIBUTION  USED  TO  FOLLOW  PARTICLE 
TRACES.  THIS  ROUTINE  CALLS  SUBROUTINE  EMODEL  TO  ACTUALLY 
COMPUTE  THE  POTENTIAL  DISTRIBUTIONS. 


KPATT  GIVES  THE  UTD  DEFINED  PATTERN  TYPE  WITH  0  CORRESPONDING 
TO  NORTHWARD  IMF  CASES;  1  TO  BZ  SOUTH  WITH  STRONGER  FLOW  ON 
THE  DAWN  SIDE  OF  THE  POLAR  CAP;  2  TO  BZ  SOUTH  WITH  SYMMETRIC 
FLOW;  AND  3  TO  BZ  SOUTH  WITH  STRONGER  FLOW  ON  THE  DUSK  SIDE. 
THIS  SUBROUTINE  CALLS  EMODEL  AFTER  TRANSLATING  THE  PATTERN 
TYPE  TO  THE  INTERNAL  EMODEL  CONVENTION  AS  GIVEN  BELOW: 


GENERAL  CALL  PARAMETERS  FOR  SUBROUTINE  EMODEL 


IP  ATT 


HEPPNER-MAYNARD  PATTERN  NO.  MUST  BE  SPECIFIED  AS  AN 
INTEGER  BETWEEN  1  AND  7. 

IPATT»1  MEANS  PATTERN  A,  FOR  BZ  SOUTH,  BY=0. 


MSM66560 

MSM66570 

MSM66580 

MSM66590 

MSM66600 

MSM66610 

MSM66620 

MSM66630 

MSM66640 

MSM66650 

MSM66660 

MSM66670 

MSM66680 

MSM66690 

MSM66700 

MSM66710 

MSM66720 

MSM66730 

MSM66740 

MSM66750 

MSM66760 

MSM66770 

MSM66780 

MSM66790 

MSM66800 

MSM66810 

MSM66820 

MSM66830 

MSM66840 

MSM66850 

MSM66860 

MSM66870 

MSM66880 

MSM66890 

MSM66900 

MSM66910 

MSM66920 

MSM66930 

MSM66940 

MSM66950 

MSM66960 

MSM66970 

MSM66980 

MSM66990 

MSM67000 

MSM67010 

MSM67020 

MSM67030 

MSM67040 

MSM67050 

MSM67060 

MSM67070 

MSM67080 

MSM67090 

MSM67100 

MSM67110 

MSM67120 

MSM67130 

MSM67140 

MSM67150 

MSM67160 

MSM67170 

MSM67180 

MSM67190 


n 


IPATT=2  MEANS 
IPATT=3  MEANS 
IPATT=4  MEANS 
IPATT=5  MEANS 
IPATT-6  MEANS 
IPATT=7  MEANS 
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PATTERN  BC,  FOR  BZ  SOUTH,  BYNORTH>0 
PATTERN  DE,  FOR  BZ  SOUTH, BYNORTH<0 
PATTERN  BCP, TWISTED  BC,  FOR  BZ>0 
PATTERN  BCPP,  TWISTED  BC,BZ  STRONOO 
PATT.  DEP,  TWISTED  DE,BZ  WEAK  >0 
PATT.  DEPP,  TWISTED  DE,BZ  STRONOO 


FOR  THE  PRESENT,  NORTHWARD  IMF  CASES  ARE  ALL  TREATED  AS  IPATT=1 


PROGRAMMER:  R.W,  SPIRO 


LAST  UPDATE:  11-17-89 


DIMENSION  COLAT(LATDIM, LTDIM) , ALOCT {LATDIM, LTDIM) 
DIMENSION  V (LATDIM, LTDIM, ITMDIM) , VNORTH (LATDIM, LTDIM) 
DIMENSION  VSOUTH (LATDIM, LTDIM) 

DIMENSION  ASOUTH (3, ITMDIM) , BSOUTH (3, ITMDIM) 

DIMENSION  DXS (3, ITMDIM) , DYS (3, ITMDIM) 

DIMENSION  ANORTH (3, ITMDIM) , BNORTH (3, ITMDIM) 

DIMENSION  DXN(3, ITMDIM) , DYN (3, ITMDIM) 


IF(KPATT.EQ.O)  THEN 
NORTHWARD  BZ  CASE 
ipatt-1 

CALL  EMODEL(IPATT,PCP,DEQDT, ASOUTH (1,ITMCUR) , BSOUTH (1, ITMCUR) , 

2  DXS ( 1 , ITMCUR) , DYS (1 , ITMCUR) , COLAT, ALOCT, 

3  MODE, LATDIM, LTDIM, JWRAP, ICNTRL, ITOP, VSOUTH) 

CALL  EMODELdPATT, PCP,DEQDT,ANORTH(l, ITMCUR)  ,BNORTH(l, ITMCUR)  , 

2  DXN(1, ITMCUR) ,DYN(1, ITMCUR)  , COLAT, ALOCT, 

3  MODE, LATDIM, LTDIM, JWRAP, ICNTRL, ITOP, VNORTH) 

ELSE  IF(KPATT.EQ.-1.0R.KPATT,EQ.3)  THEN 
CASE  OF  BZ  SOUTH,  BY<0 

IPATT=2 

CALL  EMODELdPATT, PCP,DEQDT,ASOUTH(l, ITMCUR)  ,  BSOUTH  (1 ,  ITMCUR)  , 

2  DXS (1, ITMCUR) , DYS (1, ITMCUR) , COLAT, ALOCT, 

3  MODE, LATDIM, LTDIM, JWRAP, ICNTRL, ITOP, VSOUTH) 

I PATT- 3 

CALL  EMODEL(IPATT,PCP,DEQDT,ANORTH(l, ITMCUR) , BNORTH (1,  ITMCUR) , 

2  DXN (1,1 TMCUR ) , DYN (1,1 TMCUR) , COLAT , ALOCT , 

3  MODE, LATDIM, LTDIM, JWRAP, ICNTRL, ITOP, VNORTH) 

ELSE  IF(KPATT.EQ.1.0R.KPATT.EQ.-3)  THEN 
CASE  OF  BZ  SOUTH,  BY>0 

I PATT- 3 

CALL  EMODELdPATT, PCP,DEQDT,ASOUTH(l, ITMCUR)  ,  BSOUTH  (1 ,  ITMCUR)  , 

2  DXS (1, ITMCUR) ,DYS (1, ITMCUR) , COLAT, ALOCT, 

3  MODE, LATDIM,  LTDIM, JWRAP, ICNTRL, ITOP, VSOUTH) 

IPATT-2 

CALL  EMODEL(IPATT,PCP,DEQDT, ANORTH (1, ITMCUR) , BNORTH (1, ITMCUR) , 

2  DXN (1, ITMCUR) , DYN (1, ITMCUR) , COLAT, ALOCT, 

3  MODE, LATDIM, LTDIM, JWRAP, ICNTRL, ITOP, VNORTH) 

ELSE 

CASE  OF  BZ  SOUTH,  SYMMETRIC  FLOW 


IPATT-1 

CALL  EMODELdPATT,PCP,DEQDT,ASOUTH(l,  ITMCUR)  ,  BSOUTH  (1 ,  ITMCUR)  , 
DXS (1 , ITMCUR) , DYS ( 1 , ITMCUR) , COLAT,  ALOCT, 

MODE, LATDIM, LTDIM, JWRAP, ICNTRL, ITOP, VSOUTH) 


MSM67200 

MSM67210 

MSM67220 

MSM67230 

MSM67240 

MSM67250 

MSM67260 

MSM67270 

MSM67280 

MSM67290 

MSM67300 

MSM67310 

MSM67320 

MSM67330 

MSM67340 

MSM67350 

MSM67360 

MSM67370 

MSM67380 

MSM67390 

MSM67400 

MSM67410 

MSM67420 

MSM67430 

MSM67440 

MSM67450 

MSM67460 

MSM67470 

MSM67480 

MSM67490 

MSM67500 

MSM67510 

MSM67520 

MSM67530 

MSM67540 

MSM67550 

MSM67560 

MSM67570 

MSM67580 

MSM67590 

MSM67600 

MSM67610 

MSM67620 

MSM67630 

MSM67640 

MSM67650 

MSM67660 

MSM67670 

MSM67680 

MSM67690 

MSM67700 

MSM67710 

MSM67720 

MSM67730 

MSM67740 

MSM67750 

MSM67760 

MSM67770 

MSM67780 

MSM67790 

MSM67800 

MSM67810 

MSM67820 

MSM67830 


o  o  o  o  o  o  o 
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c 

CALL  EMODEL (IPATT, PCP, DEQDT, ANORTH (1,  ITMCUR) , BNORTH (1, ITMCUR) , 

2  DXN(1, ITMCUR) ,DYN{1, ITMCUR) , COLAT, ALOCT, 

3  MODE, LATDIM, LTDIM, JWRAP, ICNTRL, ITOP, VNORTH) 

C 

END  IF 

COMPUTE  V=POTENTIAL  USED  IN  TRACING  PARTICLE  TRAJECTORIES=AVG  OF 
VNORTH  AND  VSOUTH 

DO  100  J»l, LTDIM 

DO  110  1=1, LATDIM 

V(I, J, ITMCUR) = (VSOUTH (I, J)+VNORTH( I, J) ) /2. 

110  CONTINUE 
100  CONTINUE 


RETURN 
END 

SUBROUTINE  PWRCAL (LATDIM, LTDIM, ISPDIM, ITMDIM, ITMCUR, FKP, FLXSUM, 

2  EAVG, COLAT, ALOCT, ALPHA, BETA, BNDLOC, A, B, DX, DY) 

C 

C  PURPOSE:  ESTIMATE  PRECIPITATING  ELECTRON  ENERGY  FLUX  POLEWARD  OF 
C  THE  MAIN  MSM  MODELING  REGION  BY  COMPARING  FLUX  WITHIN 

C  MODELING  REGION  WITH  HARDY  STATISTICAL  VALUES.  THIS  ROUTINE 

C  IS  BASED  ON  SUBROUTINE  PWRCAL  IN  THE  RCM  SOURCE  CODE;  THE 

C  RATIONALE  FOR  THE  METHOD  IS  GIVEN  IN  AN  R.A.  WOLF  DOCUMENT 

C  'PROPOSED  PROCEDURE  FOR  ESTIMATING  PRECIPITATING  ENERGY 

C  FLUX  AND  AVERAGE  ENERGY  POLEWARD  OF  RCM' S  MAIN  MODELING 

C  REGION'  DATED  02-27-89. 

C 

C  PROGRAMMER:  R.W.  SPIRO  LAST  UPDATE:  11-29-89 

C 


c 

CALLING  PARAMETERS: 

c 

LATDIM 

LATITUDINAL  DIMENSION 

c 

LTDIM 

LOCAL  TIME  DIMENSION 

c 

ISPDIM 

MASS  SPECIES  DIMENSION 

c 

ITMDIM 

TIME  LABEL  DIMENSION 

c 

ITMCUR 

CURRENT  TIME  LABEL 

c 

FKP 

FLOATING  PT  KP  VALUE 

c 

FLXSUM 

PRECIPITATING  ENERGY  FLUX  ARRAY  IN  UNITS  OF 

c 

ERG/CM**2/S 

c 

EAVG 

AVERAGE  ENERGY  ARRAY 

c 

COLAT 

COLATITUDE  ARRAY  (RADIANS) 

c 

ALOCT 

LOCAL  TIME  ANGLE  ARRAY  (RADIANS  EASTWARD  FROM 

c 

LOCAL  NOON) 

c 

ALPHA 

LATITUDINAL  GRID  SPACING  VECTOR 

c 

BETA 

LOCAL  TIME  GRID  SPACING  VECTOR 

c 

BNDLOC 

OUTER  BNDY  OF  DETAILED  MSM  CALCULATION 

c 

A,B,DX,DY 

PARAMETERS  SPECIFYING  ELECTRIC  FIELD  BNDY 

c 

ELLIPSES 

C 

C 

PARAMETER ( JDIM=51 ) 

COMMON  /GRID/  DLAM, DPSI, RI, JWRAP 
C 

DIMENSION  FLXSUM (LATDIM, LTDIM, ISPDIM) , EAVG (LATDIM, LTDIM, ISPDIM) 
DIMENSION  COLAT (LATDIM, LTDIM) , ALOCT (LATDIM, LTDIM) 

DIMENSION  ALPHA (LATDIM) , BETA (LATDIM) , BNDLOC (LTDIM, ITMDIM) 
DIMENSION  A(3) ,B(3) ,DX(3) ,DY(3) 

C 


MSM67840 

MSM67850 

MSM67860 

MSM67870 

MSM67880 

MSM67890 

MSM67900 

MSM67910 

MSM67920 

MSM67930 

MSM67940 

MSM67950 

MSM67960 

MSM67970 

MSM67980 

MSM67990 

MSM68000 

MSM68010 

MSM68020 

MSM68030 

MSM68040 

MSM68050 

MSM68060 

MSM68070 

MSM68080 

MSM68090 

MSM68100 

MSM68110 

MSM68120 

MSM68130 

MSM68140 

MSM68150 

MSM68160 

MSM68170 

MSM68180 

MSM68190 

MSM68200 

MSM68210 

MSM68220 

MSM68230 

MSM68240 

MSM68250 

MSM68260 

MSM68270 

MSM68280 

MSM68290 

MSM68300 

MSM68310 

MSM68320 

MSM68330 

MSM68340 

MSM68350 

MSM68360 

MSM68370 

MSM68380 

MSM68390 

MSM68400 

MSM6841C 

MSM68420 

MSM68430 

MSM68440 

MSM68450 

MSM68460 

MSM68470 


msml.for 


DIMENSION  XMLT(2t3)  ,PWRKP  (26,7)  ,PTOT{JDIM)  ,PWRTOT{JDIM)  MSM68480 

DIMENSION  FRACT(JDIM) , RENORM (JDIM) ,PWRMDL(JDIM)  MSM68490 

MSM68500 

C  PWRMDL(J) -TOTAL  PRECIPITATED  POWER  WITHIN  MODEL  REGION  PER  J  GRID  LINEMSM68510 


C  PTOT(J) -OBSERVED  POWER  PER  HOUR  OF  LOCAL  TIME^D (LT) /DJ  AT  JGRID  FOR 
C  GIVEN  KP  VALUE 

C 

C  PWRTOT (J) -OBSERVED  POWER  CORRECTED  FOR  OUR  MODELING  REGION 
C  -PTOT(J) * (l.-FRACT(J) ) 

C 

C  RENORM (J)-PWRMDL(J) /PWRTOT (J) 

C 


DATA  XMLT/11. 5, 12. 5, 13. 5, 14. 5, 15. 5, 16. 5, 17. 5, 18. 5, 

$  19.5,20.5,21.5,22.5,23.5,24.5, 

$  25.5,26.5,27.5,28.5,29.5,30.5, 

S  31.5,32.5,33.5,34.5,35.5,36.5/ 

PWRKP  VALUES  COME  FROM  INTEGRATING  HARDY  MODEL  OVER  LATITUDE  USING 
PROGRAM  SUMHDY  (NOVEMBER,  1989) 

DATA  PWRKP  /. 161, .171, .156, .168, .140, .127, .126, .109, .095, .097, 

1  .131, .222, .280, .209, .147, .142, . 168, . 211, . 185, .159, 

1  .173, .189, .174, .156, .161, .171, 

2  .201, .146, .132, .164, .168, .161, .171,  .226,  .290,  .303, 

2  .320, .387, .483, .520, .454, .424, .453, .464,  .403,  .353, 

2  .346, .326, .285, .243,  .201,  .146, 

3  .280,  .183, .156, .207, .271, .258, . 254, . 317, . 430, .532, 

3  .624, .751, .898,1.05,1.14,1.15, .959,  .689,  .615,  .605, 

3  .564, .515, .455, .388, .280, .183, 

4  .263, .209, .224, . 271, . 300, . 368, . 585, .915,1.09,1.01, 

4  .973,1.23,1.64,1.83,1.72,1.61,1.63,1.60,1.31,  .999, 

4  .872, .841, .688, .428, .263, .209, 

5  .263, .189, .166, .195, .215, .360, .699,1.01,1.48,1.65, 

5  1.57,1.57,1.92,2.18,1.84,1.55,1 .76,2.25,2.12,1.49, 

5  1.21,1.10, .784, .433, .263,  .189, 

6  .287, .229, .265, .340, .550, .880, .969,1.39,2.19,2.24, 

6  1.72,1.62,2.00,2.41,1.91,1.84,2.58,2.98,2.34,1.69, 

6  1.32, .978, .644, .425, .287, .229, 

7  .360, .315, .279, .309, .472, .849,1.60,2.42,3.12,3.27, 

7  3.15,3.99, 6.21,7.26,5.63,4.19,4.45,5.02,4.12,2.89, 

7  2.06,1.38, .730, .431, .360,  .315/ 

PI-ATAN2(0.,-1.) 

DLTDJ-24 . /FLOAT (LTDIM-JWRAP) 

BKP-FKP+1 . 

IF(BKP.GT.7.)  BKP-7. 

CHECK  DIMENSION  COMPATIBILITY 
IF(JDIM.NE.LTDIM)  THEN 

WRITE (6,*)  ’****  DIMENSION  ERROR  IN  SUBROUTINE  PWRCAL  ****' 
WRITE (6,*)  '  JDIM-' , JDIM, '  LTDIM-' , LTDIM 

WRITE (6,*)  •****  STOPPING  PROGRAM  IN  PWRCAL  ****’ 

STOP 
END  IF 

COMPUTE  PTOT  AND  PWRTOT 


DO  10  J-JWRAP,LTDIM-1 

IMIN-NINT (BNDLOC ( J, ITMCUR) + . 5) 
FRACT ( J) -0 . 5+ . 3*SIN (ALOCT (IMIN, J) ) 
TIME-ALOCT (IMIN, J) *12 . /PI  +  12  . 


MSM68520 

MSM68530 

MSM68540 

MSM68550 

MSM68560 

MSM68570 

MSM68580 

MSM68590 

MSM68600 

MSM68610 

MSM68620 

MSM68630 

MSM68640 

MSM68650 

MSM68660 

MSM68670 

MSM68680 

MSM68690 

MSM68700 

MSM68710 

MSM68720 

MSM68730 

MSM68740 

MSM68750 

MSM68760 

MSM68770 

MSM68780 

MSM68790 

MSM68800 

MSM68810 

MSM66620 

MSM68830 

MSM68840 

MSM68850 

MSM68860 

MSM68870 

MSM68880 

MSM68890 

MSM68900 

MSM68910 

MSM68920 

MSM68930 

MSM68940 

MSM68950 

MSM68960 

MSM68970 

MSM68980 

MSM68990 

MSM69000 

MSM69010 

MSM69020 

MSM69030 

MSM69040 

MSM69050 

MSM69060 

MSM69070 

MSM69080 

MSM69090 

MSM69100 

MSM69110 


o  o  o  o  n  on 


msml.for 

DO  20  N=l,25 

IF(TIME.GT.XMLT(N) . AND . TIME . LE . XMLT (N+1 ) )  THEN 
F- (TIME-XMLT (N) ) / (XMLT (N+1 ) -XMLT (N) ) 
BXMLT=FLOAT (N) +F 
GO  TO  15 
END  IF 
20  CONTINUE 

WRITE (6, *) ' ****  ERROR  IN  PWRCAL  ****' 

WRITE(6,*)  TIME=',TIME 

WRITE (6,*)  'STOPPING  PGM  IN  PWRCAL' 

STOP 

15  CONTINUE 

PTOT ( J) -G3NTRP (PWRKP, 26, 7, 1,  BXMLT,  BKP,  1 . ) 

PTOT ( J) “PTOT ( J) *DLTDJ 

PWRTOT ( J) -PTOT ( J) * (1 . -FRACT ( J) ) 

PWRMDL(J)-0. 

IMAX-LATDIM 

DO  30  I-IMIN,IMAX 

PWRMDL ( J ) “PWRMDL ( J) +FLXSUM ( I , J, 1 ) ‘ALPHA ( I ) ‘BETA ( I ) 
30  CONTINUE 

PWRMDL  (J)  -1  ,E-6*DLAM*DPSI*RI“2*PWRMDL(J) 

40  CONTINUE 

PWRMDL (J)  IS  IN  UNITS  OF  GW/GRID  LINE 


RENORM ( J) -PWRMDL ( J) /PWRTOT ( J) 

10  CONTINUE 
CIRCULARIZE 

RENORM ( 1 ) -RENORM ( JDIM-2 ) 

RENORM (2 ) -RENORM ( JDIM-1 ) 

RENORM ( JDIM) -RENORM ( JWRAP ) 

PTOT ( 1 ) -PTOT ( JDIM-2 ) 

PTOT (2 ) -PTOT (JDIM-1 ) 

PTOT (JDIM) -PTOT (JWRAP) 

FRACT (1) -FRACT (JDIM-2) 

FRACT ( 2 ) -FRACT ( JD I M- 1 ) 

FRACT (JDIM) -FRACT (JWRAP) 

PWRTOT ( 1 ) -PWRTOT (JDIM-2 ) 

PWRTOT ( 2 ) -PWRTOT (JDIM-1) 

PWRTOT (JDIM) -PWRTOT (JWRAP) 

PWRMDL ( 1 ) -PWRMDL ( JDIM-2 ) 

PWRMDL ( 2 ) -PWRMDL ( JD IM- 1 ) 

PWRMDL (JDIM) -PWRMDL (JWRAP) 

DEBUG  6.06.90  S$$$ 

CALL  OUTP (PWRMDL, 1, JDIM, 1, 1, 1, 1, JDIM, 1, 0 . 0, ' PWRMDL' ,6,132) 
CALL  OUTP (PTOT, 1 , JDIM, 1,1, 1,1, JDIM, 1,0.0,' PTOT' ,6,132) 

CALL  OUTP (PWRTOT, 1 , JDIM, 1 , 1 , 1 , 1 , JDIM, 1,0.0,' PWRTOT'  ,6,132) 
CALL  OUTP (RENORM, 1, JDIM, 1, 1, 1, 1, JDIM, 1, 0. 0, 'RENORM' ,6,132) 
C  END  DEBUG  6.06.90  $$$$ 

C 

C  WRITE(6,*)  'A(l)-  ',A(1),'  B(l)-  ',B(1),'  DX(1)-  ',DX(1) 

C  WRITE(6,*)  'DYd)-  ',DY(1) 

C 

DO  100  J-1,JDIM 


MSM69120 

MSM69130 

MSM69140 

MSM69150 

MSM69160 

MSM69170 

MSM69180 

MSM69190 

MSM69200 

MSM69210 

MSM69220 

MSM69230 

MSM69240 

MSM69250 

MSM69260 

MSM69270 

MSM69280 

MSM69290 

MSM69300 

MSM69310 

MSM69320 

MSM69330 

MSM69340 

MSM69350 

MSM69360 

MSM69370 

MSM69380 

MSM69390 

MSM69400 

MSM69410 

MSM69420 

MSM69430 

MSM69440 

MSM69450 

MSM69460 

MSM69470 

MSM69480 

MSM69490 

MSM69500 

MSM69510 

MSM69520 

MSM69530 

MSM69540 

MSM69550 

MSM69560 

MSM69570 

MSM69580 

MSM69590 

MSM69600 

MSM69610 

MSM69620 

MSM69630 

MSM69640 

MSM69650 

MSM69660 

MSM69670 

MSM69680 

MSM69690 

MSM69700 

MSM69710 

MSM69720 

MSM69730 

MSM69740 

MSM69750 


oo  oooonooooo  non 


12:03:44  j 


msml.for 

IMIN=NINT(BNDLOC(J,  ITMCUR)  +  .5) 

PT-FRACT ( J) *PTOT ( J) 

C0LATA-THET(A(1) ,B(1) ,DX(1) , DY (1 ) , ALOCT (IMIN,  J) ) *PI/180. 
WRITE(6,*)  'J=  ',J, '  COLATA=  ' , COLATA, '  PT=  ' , PT 


C  FIND  I  VALUE  SUCH  THAT  COLAT(I,J)  .LT.  COLATA  .LT.  COLAT(I+l,J) 
C 

DO  110  II=1,IMIN-1 
I=II 

IF (COLATA. LT.COLAT(I+l,J) .AND. 

2  COLATA.GE.COLATd,  J)  )  GO  TO  120 

110  CONTINUE 

IF  PROGRAM  REACHES  THIS  PT,  WE'VE  GOT  PROBLEMS 

WRITE(6,*)  'PROBLEMS  IN  PWRCAL  ROUTINE;  COLATA=  ', COLATA, 
2  '  IMIN-  ' , IMIN 

WRITE (6,*)  'J“  ',J 

WRITE (6,*)  'STOPPING  PROGRAM  IN  PWRCAL' 

STOP 


120  CONTINUE 

BIL=FLOAT(I)  +  (COLATA-COLATd,  J)  )  /  (COLATd  +  1,  J)  -COLATd,  J)  ) 
DETERMINE  CONSTANTS  AX,BX,  AND  CX 


Pl-1 . E-6*FLXSUM (IMIN+l , J, 1 ) ‘ALPHA (IMIN+l ) ‘BETA (IMIN+l ) * 
DLAM‘DPSI‘RI“2 

P2-1  .E-6‘FLXSUMdMIN+2,  J,  1)  ‘ALPHA  dMIN+2 )  ‘BETA  dMIN+2 )  ‘ 
DLAM‘DPSI‘RI“2 
FIZ-FLOAT (IMIN) -BIL 
FIl-FLOAT (IMIN+1 ) -BIL 
FI2-FL0AT(IMIN+2) -BIL 

AX-(PT-(  (P1‘FI2“3-P2‘FI1“3)  /3.  +  (P2‘FIl“2-Pl‘Fl2“2)  ‘FIZ/4 
‘FIZ“3/  (FI1“2‘FI2“2)  )  /  (  (FI2“2/2. )  ‘  (l.-2.‘  (FI1+FI2)  ‘ 
FIZ/  (3.‘FI1‘FI2)+FIZ“2/  (2.‘F11‘FI2)  )  ) 


BX-(P1‘FI2“3-P2‘FI1“3-AX‘FI1‘FI2‘  (FI1+FI2)  )  / 

2  (AX‘FI1“2‘FI2“2) 

CX-(P2‘FI1“2-P1‘FI2“2+AX‘FI1‘FI2)  /  (AX‘FI1“2‘FI2“2) 

ILIM-BIL+.5 
IF(J.EQ.12)  THEN 

WRITE (6, ‘)  ' I, IMIN,C0LATA,BIL,P1,P2,FIZ,FI1,FI2,AX,BX,CX' 
WRITE (6, ‘)  I, IMIN,C0LATA,BIL,P1,P2,FIZ,FI1,FI2,AX,BX,CX 
END  IF 

DO  130  I-1,IMIN 

FIM-FLOAT (I ) - . 5-BIL 
FIP-FLOAT (I ) + . 5-BIL 
IFd.LT.ILIM)  THEN 
PS-0. 

ELSE  IFd.EQ.ILIM)  THEN 

PS-AX*  (FIP“2/2.+BX‘FIP“3/3.+CX‘FIP“4/4  .  ) 

ELSE 

PS-AX‘  (  (FIP“2-FIM“2)  /2  . 


MSM69760 
MSM69770 
MSM69780 
MSM69790 
MSM69800 
MSM69810 
MSM69820 
MSM69830 
MSM69840 
MSM69850 
MSM69860 
MSM69870 
MSM69880 
MSM69890 
MSM69900 
MSM69910 
MSM69920 
MSM69930 
MSM69940 
MSM69950 
MSM69960 
MSM69970 
M3M69980 
MSM69990 
MSM70000 
MSM7f'010 
MSM70020 
MSM70030 
MSM70040 
MSM70050 
MSM70060 
MSM70070 
MSM70080 
MSM70090 
MSM70100 
MSM70110 
MSM70120 
MSM70130 
MSM70140 
)  MSM70150 
MSM70160 
MSM70170 
MSM70180 
MSM70190 
MSM70200 
MSM70210 
MSM70220 
MSM70230 
MSM70240 
MSM70250 
MSM70260 
MSM70270 
MSM70280 
MSM70290 
MSM70300 
MSM70310 
MSM70320 
MSM70330 
MSM70340 
MSM70350 
MSM70360 
MSM70370 
MSM70380 
MSM70390 


oooooo  n  n  n  n  n  n  oo 


msml.for 

+BX* (FIP**3-FIM**3) /3. 
+CX* (FIP**4-FIM**4) /4.) 


END  IF 


C 

C 

C 


IF(PS.GE.O.)  THEN 

FLXSUMd,  J,  1)=1.E6*PS/  (ALPHA(I)  *BETA  (I)  *DLAM*DPSI*RI**2) 
EAVGd,  J,l)  =  (1.7-1. 3*C0S  (ALOCTd,  J)  )  )  *1.E3 
ELSE 

GO  TO  150 
END  IF 

130  CONTINUE 

GO  TO  200 

150  CONTINUE 

TO  GET  HERE  MEANS  PS  .LT.  0  FOR  SOME  GRID  PT 
ILIM=BIL-.5 

DD-FLOAT (IMIN-ILIM) + . 5 
PS=PT/DD 

DO  160  I=ILIM, IMIN-1 

FLXSUMd,  J,  1)=1.E6*PS/  (ALPHA  d)  *BETA  (I)  *DLAM*DPSI*RI**2) 
EAVGd,  J,l)- (1.7-1. 3*COS  (ALOCTd,  J)  )  )*1.E3 
160  CONTINUE 

FLXSUMdMIN,  J,  1)  =  .5*1.E6*PS/  (ALPHA  (I)  *BETA(I)  *DLAM*DPSI*RI**2) 
EAVGdMIN,  J,  1)=3. 

200  CONTINUE 

DEBUG  PRINTOUT  PARAMETERS 

BIl=FLOAT(IMIN+l) -BIL 
BI2=FL0AT (IMIN+2) -BIL 

PX1=AX* (BI1+BX*BI1**2+CX*BI1**3) 

PX2-AX* (BI2+BX*BI2**2+CX*BI2**3) 

IL=BIL-.5 

IH=IMIN-1 

PXT=0. 

DO  210  I=IL,IH 

PXT=PXT+1 .E-6*FLXSUM(I, J,l) *ALPHA(I) *BETA(I) *DLAM*DPSI*RI**2 
210  CONTINUE 

BIX=FLOAT (IMIN) -BIL 
BIY=FLOAT(IMIN) -.5-BIL 

PXT*PXT+AX* ( (BIX**2-BIY**2) /2.+BX* (BIX**3-BIY**3) /3. 

2  +CX* (BIX**4-BIY**4) /4 . ) 


100  CONTINUE 


RETURN 

END 

FUNCTION  WKRATE (RMID, RPPMID, PMID, ENRG) 

PURPOSE:  FUNCTION  SUBPROGRAM  TO  EVALUATE  WEAK  PRECIPITATION  LOSS 

RATE  AS  DESCRIBED  IN  R.A.  WOLF  DOCUMENT  'PITCH  ANGLE 
SCATTERING  ASSUMPTIONS  FOR  1/90  MSM  RUNS'  DATED  1/4/90. 


111 


PROGnUMMB'D  • 


DATE:  0i.0t).90 


MSM70400 

MSM70410 

MSM70420 

MSM70430 

MSM70440 

MSM70450 

MSM70460 

MSM70470 

MSM70480 

MSM70490 

MSM70500 

MSM70510 

MSM70520 

MSM70530 

MSM70540 

MSM70550 

MSM70560 

MSM70570 

MSM70580 

MSM70590 

MSM70600 

MSM70610 

MSM70620 

MSM70630 

MSM70640 

MSM70650 

MSM70660 

MSM70670 

MSM70680 

MSM70690 

MSM70700 

MSM70710 

MSM70720 

MSM70730 

MSM70740 

MSM70750 

MSM70760 

MSM70770 

MSM70780 

MSM70790 

MSM70800 

MSM70810 

MSM70820 

MSM70830 

MSM70840 

MSM70850 

MSM70860 

MSM70870 

MSM70880 

MSM70890 

MSM70900 

MSM70910 

MSM70920 

MSM70930 

MSM70940 

MSM70950 

MSM70960 

MSM70970 

MSM70980 

MSM70990 

MSM71000 

MSM71010 

MSM71020 

MSM71030 


msml.for 


c 

c 

c 

c 

c 

c 

c 

c 

c 


INPUT  PARAMETERS: 
RMID 

RPPMID 

PMID 

ENRG 


R  VALUE  AT  PT  WHERE  WKRATE  IS  TO  BE  EVALUATED 
(RE) 

ESTIMATE  OF  PLASMAPAUSE  RADIUS  (RE) 

LOCAL  TIME  HOUR  ANGLE  IN  EQUATORIAL  PLANE 
(RADIANS  FROM  LOCAL  NOON) 

PARTICLE  ENERGY  (EV) 


IF (RMID. LE. RPPMID)  THEN 
USE  LYONS  RESULTS 

WKRATE=RLYONS (RMID, ENRG) 
GO  TO  100 

ELSE  IF(ENRG.LE.20.E3)  THEN 
WKRATE=0 . 

GO  TO  100 
ELSE 

WKGEO=MIN (ENRG/20 . E3-1 . ,  1 . 


) * (l.+(9./ll. ) *COS (PMID) ) /1200, 


C 

C 

C 

C 

C 


IF(RMID.GT.6.6)  THEN 
WKRATE=WKGEO 
GO  TO  100 
ELSE 

XLYONS=RLYONS (RPPMID, ENRG) 

WKRATE=( (6. 6-RMID) / (6. 6-RPPMID) ) *XLYONS+ 

2  ( (RMID-RPPMID) / ( 6 . 6-RPPMID) ) *WKGEO 

END  IF 
END  IF 

100  CONTINUE 

IF (WKRATE. GT. 10.)  THEN 

WRI TE ( 6 , 8  0  0 )  RMID , RPPMID , PMID , ENRG, WKRATE 
800  FORMATdX,  'WKRATE.GT.IO'  /IX,  'RMID='  ,F6.3,2X,  'RPPMID='  ,F6.3,2X, 

2  'PMID=' ,F6.3,2X, 'ENRG=' ,1PE12.3,2X, 'WKRATE=' ,E12.3) 

END  IF 
RETURN 
END 

REAL  FUNCTION  RLYONS (RMID, ENRG) 

PURPOSE:  FUNCTION  SUBPROGRAM  TO  EVALUATE  LYONS-BASED  WEAK  LOSS  RATE 


PROGRAMMER:  R.W.  SPIRO 


DATE:  01.05.90 


C 

C 

C 


IF(ENRG.LE.50.E3)  THEN 

XLOGLO= (4 . 9365+15 . 8621) -6 . 06897*RMID+0 . 
XLOGHI= (4 . 9365+13 . 5172) -5 . 58621*RMID+0 . 
F-(ENRG-20.E3) / ( 50 . E3-20 . E3) 

ELSE  IF(ENRG.GT.50.E3.AND.ENRG.LE.200.E3) 
XLOGLO= (4. 9365+13. 5172) -5 . 58621*RMID+0 . 
XLOGHI- (4 . 9365+1 . 15517) -0 . 42069*RMID+0 . 
F-(ENRG-50.E3) / (200 . E3-50 .E3) 

ELSE 

XLOGLO= (4 . 9365+1 . 15517) -0 . 42069*RMID+0 . 
XLOGHI- (4 . 9365+3 . 89655) -1 . 75862*RMID+0 . 
F-(ENRG-200.E3) / (500 . E3-200 . E3) 

END  IF 

XLOG- (1 . -F) *XLOGLO+F*XLOGHI 

TAU-10.**XLOG 

XLYONS-1 . /TAU 
RLYONS-XT.YONS 


551724*RMID**2 

551724*RMID**2 

THEN 

551724*RMID**2 

0275862*RMID**2 


0275862*RMID**2 

206897*RMID**2 


MSM71040 

MSM71050 

MSM71060 

MSM71070 

MSM71080 

MSM71090 

MSM71100 

MSM71110 

MSM71120 

MSM71130 

MSM71140 

MSM71150 

MSM71160 

MSM71170 

MSM71180 

MSM71190 

MSM71200 

MSM71210 

MSM71220 

MSM71230 

MSM71240 

MSM71250 

MSM71260 

MSM71270 

MSM71280 

MSM71290 

MSM71300 

MSM71310 

MSM71320 

MSM71330 

MSM71340 

MSM71350 

MSM71360 

MSM71370 

MSM71380 

MSM71390 

MSM71400 

MSM71410 

MSM71420 

.MSM71430 

MSM71440 

MSM71450 

MSM71460 

MSM71470 

MSM71480 

MSM71490 

MSM71500 

MSM71510 

MSM71520 

MSM71530 

MSM71540 

MSM71550 

MSM71560 

MSM71570 

MSM71580 

MSM71590 

MSM71600 

MSM71610 

MSM71620 

MSM71630 

MSM71640 

MSM71650 

MSM71660 

HSH71670 


msml.for 

c 

RETURN 

END 

FUNCTION  G3TRPA (A, IMAX, UMAX, KMAX, BI , B J, BK) 

C 

C  VERSION  1.00  DATE:  01.09.90 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


C 

C 

C 


C 


C 

C 


C 


C 


PURPOSE:  FUNCTION  SUBPROGRAM  TO  PERFORM  A  GENERAL  3-D  LINEAR 

INTERPOLATION  OF  ANGULAR  ARRAY  A(I,J,K)  AT  PT (BV (1) , BV (2) , BV (3) ) 

INPUT : 

A  3-D  ARRAY  TO  BE  INTERPOLATED 

INTERPOLATE  A 


COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT,  LUBNDL,  I.TIPDAT,  LUVN,  LUVS,  LIONEG,  LIONNO,  LUENCH 
DIMENSION  A<IMAX,  JMAX,KMAX) 

DIMENSION  NDX(3) ,NDIM(3) ,BV{3) ,COEF(3,2) 

PREPARE  INDICES  FOR  INTERPOLATION 

PI=ATAN2(0.,-1.) 

NDIM(1)«=IMAX 

NDIM<2)»JMAX 

NDIM(3)»KMAX 

BV(1)=BI 

BV(2)=BJ 

BV(3)»BK 

DO  10  L=l,3 

NDX(L)=BV(L) 

IF(NDX(L) .LT.l)  NDX(L)=1 

IF(NDX(L) .GT.NDIM(L) -1)  NDX (L) =NDIM(L) -1 

IF(NDX(L) .LE.O)  NDX(L)=1 

FNDX=REAL (NDX (L) ) 

COEF (L, 1) “1 . -BV (L) +FNDX 
COEF(L,2)=BV(L) -FNDX 
10  CONTINUE 


G3TRPA=0 . 

IC=0 

KSTOP  =  MIN (KMAX, 2) 

JSTOP  -  MIN (UMAX, 2) 

DO  20  1-1,2 
DO  20  J-1, JSTOP 
DO  20  K-1, KSTOP 
IC-IC+1 

AVAL-A (NDX ( 1 ) +I -1 , NDX ( 2 ) + J-1 , NDX ( 3 ) +K-1 ) 
IF(IC.EQ.l)  THEN 

USE  FIRST  VALUE  OF  ARRAY  TO  SET  MODULUS 
REFMOD-AVAL 
END  IF 

IF ( (AVAL-REFMOD) . GT . PI )  THEN 
aval-aval-2 . *PI 

ELSE  IF ( (AVAL-REFMOD) . LE . -PI )  THEN 
AVAL-A VAL+ 2. *PI 
END  IF 
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G3TRPA=G3TRPA+ 

1  COEFd,  I)  *COEF(2,  J)  *C0EF(3,K)  *AVAL 
20  CONTINUE 

GET  RESULT  IN  A  REASONABLE  MODULUS 
IF(G3TRPA.GT.2. *PI)  THEN 
G3TRPA-G3TRPA-2 . *PI 
ELSE  IF{G3TRPA.LT.O.)  THEN 
G3TRPA=G3TRPA+2 . *PI 
END  IF 
RETURN 
END 

SUBROUTINE  THRCAL (FKP, FNRGLG, NRGNDX, KPNDX, IRDIM, NRGDIM, KPDIM, 

2  KPPLUS, ISPDIM,FLXMAT,THR) 

PURPOSE:  SUBROUTINE  TO  CALCULATE  THRESHOLD  FLUX  AT  R=3,4,6.6,  AND 

13  RE  FOR  KP=FKP  AND  LOG (ENERGY) =FNRGLG.  THR  IS  IN  UNITS 
OF  PARTICLES/CM**2/S/SR/EV. 


PROGRAMMER:  R.W.  SPIRO 


DATE:  05.09.90 


DIMENSION  FLXMAT (IRDIM, NRGDIM, KPPLUS, I SPDIM) ,  THR(4) ,RTHR(4) 
DIMENSION  E2ER0( 4,7) ,  RKAP(4) 

DATA  RTHR  /3 . , 4 . , 6 . 6, 13 . / 

DATA  EZERO  /23 . 5E3, 16 . E3, 21 . E3, . 49275E3, 

1  23.5E3,16.E3,4.8324E3, .625E3, 

2  23.5E3,16.E3,4.814E3, .75725E3, 

3  23.5E3,16.E3,4.7978E3, .8895E3, 

4  23.5E3,16.E3,4.816E3,1.02175, 

5  23.5E3,16.E3,4.8943E3,1.154E3, 

6  23 . 5E3, 16 .E3, 5 . 0752E3, 1 .28625E3/ 

DATA  RKAP  /2 . 8, 2 . 0, 6 . , 6 . / 


ETOP=40.E3 
ELOW-20.E3 
ENRG=10.** FNRGLG 

IF(ENRG,LE,ELOW)  THEN 

THR ( 1 ) -FLXMAT ( 1 , NRGNDX, 1 , 1 ) 

THR ( 2 ) -FLXMAT ( 2 , NRGNDX  ,1,1) 

THR ( 3 ) -FLXMAT ( 3 , NRGNDX ,  1 , 1 ) 

THR ( 4 ) =FLXMAT ( 4 , NRGNDX ,1,1) 

ELSE  IF(ENRG.GE.ETOP)  THEN 
DO  10  N-1,4 
RK=RKAP (N) 

EZ-EZERO (N, KPNDX) 

IF(RK.GE.6.0)THEN 

ER= (1 . /EZ) * ( (RK-1 . ) /RK) * (ENRG/EZ) * (1 .+ETOP/ (RK*EZ) ) **RK/ 
J  (l.+MIN(ENRG/RK/EZ,l.E5) )**(RK+1.) / (1 . +ETOP/EZ) 

ELSE 

ER-(1. /EZ) * ( (RK-1. ) /RK) * (ENRG/EZ) * (l.+ETOP/ (RK*EZ) ) **RK/ 
>  (1 . +ENRG/RK/EZ) ** (RK+1 .)/(!. +ETOP/EZ) 

ENDIF 


THR(N)-ALOG10 (5.E7*ER* (6.6/RTHR(N) ) **4) 
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10  CONTINUE 
ELSE 

ENRG  IS  BETWEEN  ELOW  AND  ETOP 

DO  20  N=l,4 
RK-RKAP (N) 

EZ=EZERO (N, KPNDX) 

ERTOP= (1 . /EZ) * ( (RK-1 . ) /RK) * (ETOP/EZ) / 

2  (l,+ETOP/RK/EZ)/(l.+ETOP/EZ) 

THRTOP-ALOGIO (5.E7*ERTOP* (6.6/RTHR(N) ) **4) 

THRLOW=FLXMAT (N, NRGNDX,  1,1) 

THR(N) = ( (ETOP-ENRG) *THRLOW+ (ENRG-ELOW) *THRTOP) / (ETOP-ELOW) 

20  CONTINUE 

END  IF 

RETURN 

END 

SUBROUTINE  FLXDFL (ITM, FKP , R, P , ALAM, VM, IRDIM, NRGDIM, KPDIM, KPPLUS, 

1  ISPDIM, FLXMAT, FLXR, FLXNRG, FLXKP, EPLUX, ETA, ALMDEL, LATDIM, 

2  LTDIM, lEDIM, ITMDIM, BNDLOC, lEMAX, IFLAV, lEBEG, lEEND) 

SUBROUTINE  WHICH  USES  THE  FLXMAT  ARRAYS  TO 
CALCULATE  THE  ENERGY-DEPENDENT  ETA  ARRAYS.  THIS  IS  THE 
DEFAULT  MODEL  WHEN  ONLY  KP  IS  AVAILABLE  TO  RUN  THE  PROGRAM. 

PARAMETER (JJDIM=51 ) 

DIMENSION  R (LATDIM, LTDIM, ITMDIM) , P (LATDIM, LTDIM, ITMDIM) , 

1  ALAM(IEDIM) ,VM( LATDIM, LTDIM, ITMDIM)  , 

2  FLXMAT (IRDIM, NRGDIM, KPPLUS, ISPDIM)  , 

3  FLXR (IRDIM) , FLXNRG (NRGDIM) , FLXKP (KPDIM)  , 

4  BNDLOC (LTDIM, ITMDIM) , EFLUX (LATDIM, LTDIM, lEDIM) , IBLOC ( JJDIM) , 

5  ETA (LATDIM, LTDIM, lEDIM) , ALMDEL (lEDIM) , IFLAV (lEDIM) 

IF (JJDIM . NE . LTDIM) THEN 

WRITE(6,*)'  DIMENSION  ERROR  IN  FLXDFL  SUBROUTINE,  PROGRAM  STOPS. 
STOP 
ENDIF 

DO  10  J=l, LTDIM 

IBLOC ( J) -IFIX (BNDLOC ( J, ITM) ) 

DO  20  I=IBLOC(J) , LATDIM 
DO  30  K=IEBEG,IEEND 
EFLUX (I, J,K) -0.0 
CONTINUE 
CONTINUE 
CONTINUE 
DO  50  J=l, LTDIM 
DO  60  I=IBLOC(J) , LATDIM 
DO  70  K-IEBEG, lEEND 
ISP-IFLAV(K) 

ENRG-ABS (ALAM (K) ) * VM ( I , J,  ITM) 

FLXOUT»FLXVAL(ISP,FKP,R(I, J, ITM) ,P(I, J, ITM) ,ENRG, IRDIM, 

1  NRGDIM, KPDIM, KPPLUS , I SPDIM, FLXMAT, FLXR,  FLXNRG, FLXKP ) 

IF  (IFLAV  (K)  .EQ.DTHEN 
XMSCNT-7.392E-16 

IF( (K.EQ.l) .OR, (K.EQ.5) .OR. (K.EQ.9) .OR. (K.EQ.13) ) THEN 
WRITE (6,*)'  I, J,K, FLUX, ENRG  ' , I » J» K, FLXOUT, ENRG 
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WRITE(6,*)'  VM,ALMDEL,MSCNST' J, ITM) ,ALMDEL(K) ,MSCNST  MSM73600 
WRITE  (6,*)'  IFIiAV  SIFLAVCK)  MSM73610 

ENDIF  MSM73620 

ETA(I, J,K)=(FLXOUT*ALMDEL(K) ) / (XMSCNT*SQRT (ABS (ALAM(K) ) )  MSM73630 

1  *VM(I, J, ITM) )  MSM73640 

IF( (K.EQ.l) .OR. (K.EQ.5) .OR. (K.EQ.9) .OR. (K.EQ. 13) ) THEN  MSM73650 

WRITE(6,*)'  ETA  ETA(I,J,K)  MSM73660 

ENDIF  MSM73670 

ELSE  MSM73680 

IONS  MSM73690 

XMSCNT-1.731E-17  MSM73700 

IF(IFLAV(K) .EQ.2)  THEN  MSM73710 

ATOMWT-1.0  MSM73720 

ELSE  MSM73730 

ATOMWT=16.0  MSM73740 

ENDIF  MSM73750 

ETA{I, J,K)={FLXOUT*ALMDEL(K) *SQRT (ATOMWT) ) / (XMSCNT*  MSM73760 

1  SQRT(ABS(ALAM(K)))*VM(I,J, ITM))  MSM73770 

ENDIF  MSM73780 

CONTINUE  MSM73790 

CONTINUE  MSM73800 

CONTINUE  MSM73810 

DO  100  K=IEBEG, lEEND  MSM73820 

IF ( (K.EQ.l) .OR. (K.EQ.5) .OR. (K.EQ. 9) .OR. (K.EQ. 13) ) THEN  MSM73830 

WRITE (18,*)'  K  =  ',K  MSM73840 

WRITE (6,*)  '  K  =  ',K  MSM73850 

CALL  OUTP(ETA(l,l,K) ,LATDIM,LTDIM,10,50,1,3,LTDIM-1,1,  MSM73860 

1  0., 'ETA' ,6,132)  MSM73870 

ENDIF  MSM73880 

)  CONTINUE  MSM73890 

RETURN  MSM73900 

END  MSM73910 

SUBROUTINE  RMVBSH (WORK, LATDIM, LTDIM)  MSM73920 

MSM73930 

TEMPORARY  FIX  TO  THE  B-FIELD  MATRICES  fO  REMOVE  THE  LARGE  DATA  MSM73940 

VALUES  SIGNIFYING  THAT  THE  FIELD  LINES  HAD  'GONE  INTO  THE  BUSHES'.  MSM73950 
IT  LOOKS  FOR  THE  CLOSEST  VALUE  IN  J  AND  LINEARLY  INTERPOLATES  FOR  MSM73960 
THE  I  VALUES.  MSM73970 

MSM73980 

DIMENSION  WORK (LATDIM, LTDIM, 2, 2, 2, 2, 2)  MSM73990 

BFBUSH  =  1.E20  MSM74000 

DO  10  Nl=l,2  MSM74010 

DO  20  N2=l,2  MSM74020 

DO  30  N3-l,2  MSM74030 

DO  40  N4-l,2  MSM74040 

DO  50  N5=l,2  MSM74050 

DO  60  J=l, LTDIM  MSM74060 

DO  70  I-l, LATDIM  MSM74070 

IF(WORK(I, J,N1,N2,N3,N4,N5) .LT.BFBUSH)GO  TO  70  MSM74080 

IDO-I  MSM74090 

)  CONTINUE  MSM74100 

IDO=IDO+l  MSM74110 

IF(WORK(lDO, J,N1,N2,N3,N4,N5) .GT. BFBUSH) GO  TO  999  MSM74120 

COEFl=WORK(IDO, J,N1,N2,N3,N4,N5)  MSM74130 

COEF2=  WORK(IDO+l, J,N1,N2,N3,N4,N5)  MSM74140 

STRTLN=C0EF2-C0EF1  MSM74150 

DO  80  ICHK-IDO-1, 1, -1  MSM74160 

WORKdCHK,  J,N1,N2,N3,N4,N5)=W0RK(ICHK+1,  J,N1,N2,N3,N4,N5)  MSM74170 
1  -  STRTLN  MSM74180 

CONTINUE  MSM74190 

CONTINUE  MSM74200 

CONTINUE  MSM74210 

CONTINUE  MSM74220 

CONTINUE  MSM74230 
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CONTINUE 

CONTINUE 

CONTINUE 

RETURN 

END 

SUBROUTINE  DSTDFL (MODE, AUGPAR, NAUGEL, ITMDIM, ITM, ITMMAX, TIMTAG) 

SUBROUTINE  TO  CALCULATE  THE  DEFAULT  DST  VALUES  IF  NO 

VALUE  IS  FOUND  IN  THE  ENVIRONMENTAL  DATA  BASE.  (MODE  IS  FALSE) 

INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP, DST, DDST, 

1  EQEDGE,DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND , PCP , DEQDT , I P ATT 

COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR,  IPMIN, IPSEC, KP, DST, 

1  EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND, PCP, IPATT, DDST, DEQDT 

DIMENSION  AUGPAR (NAUGEL, ITMDIM) , TIMTAG (ITMDIM) 

DIMENSION  YA(2),XA(2) 

LOGICAL*!  MODE 
IF (MODE) RETURN 

IF (AUGPAR (KP, ITM) .LT. 4.0) THEN 
AUGPAR (DST, ITM)  =  -AUGPAR (KP, ITM) *4 . 0 
ELSE 

AUGPAR (DST, ITM)  -  -20.0  -(( (AUGPAR (KP, ITM)  *  10.0)  -  40.0)  * 
ENDIF 

IFdTM.GT.DTHEN 
YA ( 1 ) *AUGPAR (DST, ITM-1 ) 

YA (2) -AUGPAR (DST, ITM) 

XA (1 ) -TIMTAG (ITM-1 ) 

XA  (2) -TIMTAG  (ITM) 

CALL  DTNTRP (TIMTAG (ITM) , 2, XA, YA, Y,DYDX, DELTA,  lERR) 

AUGPAR (DDST , ITM-1 ) -DYDX*  3600. 

ENDIF 

I F ( I TM . EQ . I TMMAX ) AUGPAR ( DD S  T , I TM ) -AUGPAR (DDST, ITM-1) 

RETURN 

END 

SUBROUTINE  EQTDFL (MODE, AUGPAR, NAUGEL, ITMDIM, ITM, ITMMAX, TIMTAG) 

SUBROUTINE  TO  CALCULATE  A  KP-BASED  VALUE  FOR  THE 
EQUATORWARD  EDGE  OF  THE  AURORAL  OVAL  BASED  ON  THE  WORK  OF 
GUSSENHOVEN  ET.  AL.,  1983. 

IF  MODE  IS  TRUE  A  VALUE  HAS  ALREADY  BEEN  RECEIVED  FROM  THE 
ENVIRONMENTAL  DATA  BASE  AND  THE  SUBROUTINE  JUST  RETURNS. 

INTEGER  lYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP,DST, DDST, 

1  EQEDGE,  DLATAZ,  DLATRV,  MLTRV,  IMFBX,  IMFBY,  IMFBZ,  CL,\PSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND , PCP , DEQDT , IPATT 

COMMON  /ARINDX/IYEAR, IDAY, ISECND, IPHOUR, IPMIN, IPSEC, KP,DST, 

1  EQEDGE, DLATAZ, DLATRV, MLTRV, IMFBX, IMFBY, IMFBZ, CLAPSE, 

2  GEOMGX, GEOMGY, GEOMGZ, GEOMGT, LBOUND, SWVEL, SWDEN, TILTW, 

3  STAND, PCP, IPATT, DDST, DEQDT 

DIMENSION  AUGPAR (NAUGEL, ITMDIM) , TIMTAG (ITMDIM) 

DIMENSION  XA(2),YA(2) 

LOGIC.AL  MODE*l 
IF (MODE) RETURN 
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msml.for 

AUGPAR(EQEDGE,ITM)  =  67.78  -  (2.068  *  AUGPAR (KP, ITM) ) 
IF(ITM.GT.1)THEN 
YA (1 ) -AUGPAR (EQEDGE, ITM-1 ) 

YA (2 ) -AUGPAR (EQEDGE, ITM) 

XA ( 1 ) -TIMTAG ( ITM-1 ) 

XA(2)-TIMTAG(ITM) 

CALL  DTNTRP (TIMTAG (ITM) , 2 , XA, YA, Y, DYDX, DELTA, lERR) 

AUGPAR (DEQDT, ITM-1) =DYDX*3600 . 

ENDIF 

IF (ITM. EQ. ITMMAX) AUGPAR (DEQDT, ITM) -AUGPAR (DEQDT, ITM-1) 

RETURN 

END 

SUBROUTINE  PCPDFL (MODE,  XKP,  PCP) 

THIS  SUBROUTINE  CALCULATES  THE  CROSS-POLAR  CAP  POTENTIAL  (IN  KV) 
BASED  ON  THE  WORK  OF  REIFF  ET  AL  IF  MODE  IS  FALSE.  IF  MODE  IS  TRUE 
THE  POTENTIAL  HAS  ALREADY  BEEN  RECEIVED  FROM  THE  ENVIRONMENTAL  DATA 
BASE  AND  THE  SUBROUTINE  JUST  RETURNS. 
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C 

LOGICAL*!  MODE 
IF (MODE) RETURN 

PCP  -  14.587  +  (1.7  *  (XKP  *  10.0)) 

RETURN 

END 

SUBROUTINE  PATDFL (MODE, MODEBY, MODEBZ, BY, B2, IPATT) 

C 

C  THIS  SUBROUTINE  USES  THE  BY  AND  BZ  COMPONENTS  OF  THE  IMF  TO 
C  DETERMINE  THE  ELECTRIC  FIELD  PATTERN  TYPE  TO  BE  USED. 

C  THE  DIFFERENT  TYPES  ARE: 

C  BZ>0  -  TYPE  0.0 

C  BZ<0,BY>0  -  TYPE  1.0 

C  BZ<0,BY-0  -  TYPE  2.0  (DEFAULT) 

C  BZ<0,BY<0  -  TYPE  3.0 

C  IF  MODE  IS  TRUE,  THE  PATTERN  TYPE  HAS  ALREADY  BEEN  RECEIVED  FROM 
C  THE  ENVIRONMENTAL  DATA  BASE  AND  THE  SUBROUTINE  JUST  RETURNS. 

C 

LOGICAL*!  MODE,  MODEBY, MODEBZ 
IF (MODE) RETURN 
IF ( . NOT . (MODEBZ ) ) THEN 
XIPATT-2 , 0 
ELSE 

IF(B2.GT.0.0)THEN 
XIPATT-0 . 0 
ELSE 

IF ( .NOT. (MODEBY) ) THEN 
XIPATT-2 . 0 
ELSE 

IF (BY . GT . 0 . 0 ) XIPATT-1 . 0 
IF (BY. EQ. 0.0) XIPATT-2. 0 
IF (BY . LT . 0 . 0 ) XIPATT-3 . 0 
ENDIF 
ENDIF 
ENDIF 
RETURN 
END 

SUBROUTINE  CLPDFL (MODE, CLAP SE) 

C 

C  CLPASE  IS  THE  INDICATOR  FOR  WHETHER  OR  NOT  TO  USE  THE  COLLAPSED 
C  TAIL  VERSION  OF  THE  MAGNETIC  FIELD  MODEL.  IF  MODE  IS  FALSE,  NO 
C  VALUE  HAS  BEEN  RETURNED  FROM  THE  ENVIRONMENTAL  DATA  BASE.  THE 
C  DEFAULT  VALUE  IS  NO  COLLAPSE  (CLAPSE-1 . 0) . 

C 

LOGICAL* 1  MODE 
IF (MODE) RETURN 


MSM75060 

MSM75070 

MSM75080 

MSM75090 

MSM75100 

MSM75110 

MSM75120 

MSM75130 

MSM75140 

MSM75150 

MSM75160 

MSM75170 

MSM75180 

MSM75190 

MSM75200 

MSM75210 

MSM75220 

MSM75230 

MSM75240 

MSM75250 

MSM75260 

MSM75270 

MSM75280 

MSM75290 

MSM75300 

MSM75310 

MSM75320 

MSM75330 

MSM75340 

MSM75350 

MSM75360 

MSM75370 

MSM75380 

MSM75390 

MSM75400 

MSM75410 

MSM75420 

MSM75430 

MSM75440 

MSM75450 

MSM75460 

MSM75470 

MSM75480 

MSM75490 

MSM75500 

MSM75510 
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CLAPSE-l . 0 

RETURN 

END 

SUBROUTINE  STNDFL (MODE,MODVEL,MODDEN, SWVEL, SWDEN, XKP, STAND) 

THIS  SUBROUTINE  CALCULATES  THE  STANDOFF  DISTANCE.  IF  SOLAR  WIND 
VELOCITY  AND  DENSITY  DATA  IS  AVAILABLE  SUBROUTINE  STNDOF  DOES  THE 
THE  ACTUAL  CALCULATION.  OTHERWISE  THE  DEFAULT  IS  A  KP-BASED 
FORMULA. 

LOGICAL* 1  MODE , MODVEL, MODDEN 
IF (MODE) RETURN 
IF (MODVEL. AND. MODDEN) THEN 
CALL  STNDOF (SWVEL, SWDEN, STAND) 

ELSE 

IF (XKP . LT . 6 . 7 ) STAND=11 . 7-XKP 
IF (XKP . GE . 6 . 7 ) STAND=5 . 0 
ENDIF 
RETURN 
END 

SUBROUT I NE  T I LT ( DAY , YEAR , XT I LT ) 


CURRENTLY  SET 


SUBROUTINE  TO  CALCULATE  THE  EARTH'S  TILT  ANGLE. 
TO  0.0 

XTILT=0.0 

RETURN 

END 


SUBROUTINE  AURL2S (FKP, COLAT, ALOCT, LATDIM, LTDIM, 

*  AEFLUX,AEMEAN) 

[Inputs] 

FKP  ;  The  most  recent  Kp  value 

COLAT: An  array  listing  pertinent  colatitudes  <40  deg 
ALOCT: An  array  listing  pertinent  magnetic  loca  time 
[Outputs] 

AEFLUX:The  integral  ION  energy  flux  (erg/cm2/sec) 

AEMEAN : AVERAGE  ENERGY  IN  EV 

AFLUX  :The  integral  ION  number  flux  (/cm2/sec) 

This  subroutine  calls  REGEN  ()  and  EFUNO 
June  04,  1989  by  Akira  NAGAI 

Note:  The  feature  is  optimized  for  the  speed. 

At  least  10KB  static  memory  area  is  reqired 
for  REAL*2  in  MSM  Model. 

PARAMETER  (IIDIM=62, JJDIM=51) 

COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 


DIMENSION  COLAT (LATDIM, LTDIM) , ALOCT (LATDIM,  LTDIM)  , 
AFLUXdIDIM,  JJDIM)  ,  AEFLUX  (LATDIM,  LTDIM)  , 
AEMEAN (LATDIM, LTDIM) , 

XI (JJDIM, 0:6,2) ,X2 (JJDIM, 0:6,2) ,X3 (JJDIM,  0 : 6, 2) , 

X4 (JJDIM, 0:6,2) ,X5 (JJDIM, 0:6,2) ,X6 (JJDIM, 0 : 6, 2) , 

Cl (0:12) ,C2 (0:12) ,C3 (0:12) ,C4 (0:12) ,C5 (0:12)  ,C6 (0:12) 


MSM75520 

MSM75530 

MSM75540 

MSM75550 

MSM75560 

MSM75570 

MSM75580 

MSM75590 

MSM75600 

MSM75610 

MSM75620 

MSM75630 

MSM75640 

MSM75650 

MSM75660 

MSM75670 

MSM75680 

MSM75690 

MSM75700 

MSM75710 

MSM75720 

MSM75730 

MSM75740 

MSM75750 

MSM75760 

MSM75770 

MSM75780 

MSM75790 

MSM75800 

MSM75810 

MSM75820 

MSM75830 

MSM75840 

MSM75850 

MSM75860 

MSM75870 

MSM75880 

MSM75890 

MSM75900 

MSM75910 

MSM75920 

MSM75930 

MSM75940 

MSH75950 

MSM75960 

MSM75970 

MSM75980 

MSM75990 

MSM76000 

MSM76010 

MSM76020 

MSM76030 

MSM76040 

MSM76050 

MSM76060 

MSM76070 

MSM76080 

MSM76090 

MSM76100 

MSM76110 

MSM76120 

MSM76130 

MSM76140 

MSM76150 


ilEl 

SI 
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60 


30 


20 


10 


80 


C- 

C 

r. 

C 


IKP=NINT(FKP) 

IF( (IPASS.EQ.O) .AND. (IKP.EQ.O) )  GOTO  60 

IFdKP.EQ.KP)  GOTO  80 

KP-IKP 

IF(KP.GT.6)  KP=6 

Just  once  is  OK  for  this  loop (10)  for  the  entire  run. 
DO  10  ICASE=1,2 

IF(IPASS.EQ.l)  GOTO  80 

IF (ICASE . EQ . 1 ) THEN 

OPEN (UNIT-LIONNO, ACCESS=' SEQUENTIAL' , FILE=' lONNUM' , 
STATUS-' OLD' ) 

ELSE 

OPEN  <UNIT=LIONEG, ACCESS-' SEQUENTIAL' , FILE-' lONENG' , 
STATUS-' OLD' ) 

ENDIF 


DO  20  IKP-0,6 
DO  30  J-0,12 
IFdCASE.EQ.DTHEN 
READ(LIONNO, *)  IDX,C1 
ELSE 

READ(LIONEG,*)  IDX,C1 
ENDIF 
CONTINUE 

CALL  REGEN (LATDIM,LTDIM 
REGEN (LATDIM, LTDIM 
REGEN (LATDIM, LTDIM 
REGEN (LATDIM, LTDIM 
REGEN (LATDIM, LTDIM 
REGEN (LATDIM, LTDIM 


(J),C2(J),C3(J),C4 (J) ,C5(J),C6(J) 
( J) , C2 ( J) , C3 ( J) ,  C4 ( J) ,  C5 ( J) ,  C6 ( J) 


,  ALOCT, Cl , XI , JJDIM, IKP , ICASE) 
,  ALOCT, C2 , X2, JJDIM, IKP , ICASE) 
,  ALOCT, C3, X3, JJDIM, IKP, ICASE) 
,  ALOCT, C4,X4, JJDIM, IKP, ICASE) 
,  ALOCT, C5,X5, JJDIM, IKP, ICASE) 
,  ALOCT, C6, X6, JJDIM, IKP, ICASE) 


CALL 
CALL 
CALL 
CALL 
CALL 
CONTINUE 
CLOSE (LIONNO) 
CLOSE (LIONEG) 
CONTINUE 

IPASS-1 


DO  40  IMLT-1, LTDIM 
DO  50  ILAT-1, LATDIM 

H-90.-ABS  (COLATdLAT,  IMLT) )  *180/3. 14159 
FX-EFUN(1,KP,H,X1 (IMLT, KP, 1 ) ,X2 (IMLT,KP, 1) , 

X3(IMLT,KP,1) ,X4 (IMLT,KP,1) , X5 (IMLT, KP, 1 ) , X6 (IMLT, KP, 1 ) ) 
Unit  from  l/cm2/sec/3tr  to  l/cm2/sec 
AFLUX(ILAT,IMLT)  -  (10 . **FX) *3 . 1415265358 
FX-EFUN(2,KP,H,X1  (IMLT,  KP,  2)  ,  X2  dMLT,KP,2)  , 

X3 (IMLT,KP,2) ,X4 (IMLT,KP,2) ,X5 (IMLT, KP, 2) ,X6 (IMLT, KP, 2) ) 
Unit  from  )teV/cm2/sec/str  to  erg/cmZ/sec 
AEFLUX(ILAT,IMLT)=  (10 . **FX) *3. 14159265358*1 . 6021E-9 
IF(AFLUX(ILAT,  ILMT)  .  NE  .  0 . 0)  AEMEANdLAT,  IMLT)  - 
AEFLUX(ILAT,IMLT) /AFLUX (ILAT, IMLT) 

AEMEANdLAT,  IMLT) -AEME  AN  (ILAT,  IMLT)  *6.24E11 


FUNCTION  EFUN(ICASE,KP,H,R0,H0,H1,S0,R1,S2) 

This  function  is  called  only  by  AURl2S()  and  thxS  does  not 


MSM76160 

MSM76170 

MSM76180 

MSM76190 

MSM76200 

MSM76210 

MSM76220 

MSM76230 

MSM76240 

MSM76250 

MSM76260 

MSM76270 

MSM76275 

MSM76280 

MSM76290 

MSM76295 

MSM76300 

MSM76310 

MSM76320 

MSM76330 

MSM76340 

MSM76350 

MSM76360 

MSM76370 

MSM76380 

MSM76390 

MSM76400 

MSM76410 

MSM76420 

MSM76430 

MSM76440 

MSM76450 

MSM76460 

MSM76470 

MSM76480 

MSM76490 

MSM76500 

MSM76510 

MSM76520 

MSM76530 

MSM76540 

MSM76550 

MSM76560 

MSM76570 

MSM76580 

MSM76590 

MSM76600 

MSM76610 

MSM76620 

MSM76630 

MSM76640 

MSM76650 

MSM76660 

MSM76670 


50 

CONTINUE 

MSM76680 

40 

CONTINUE 

MSM76690 

MSM76700 

99 

RETURN 

MSM76710 

END 

MSM76720 

MSM76730 

MSM76740 

MSM76750 

MSM76760 

MSM76770 


oooo  n  *>ooo  oo  oo 


C 


48 


C 


60 

50 


msml.for 

XL0= ( ENERGY -HAFCHN (NCHNL) ) / (HAFCHN (NCHNL-1 ) - 

HAFCHN (NCHNL) ) 


CONTINUE 

XL1=1 . -XLO 

XSTFLX-XLO*SATFLX (KK) +XL1*SATFLX (KK+1) 

DO  50  INO=l,LATDIM 
DO  60  JNO=l,LTDIM 

FLXNTRdNO,  JNO,  1)  =FLUX  (INO,  JNO,  ENERGY) 

FliXNTR  (I NO,  JNO,  2)  =FLUX1  (INO,  JNO,  ENERGY) 
CONTINUE 
CONTINUE 

FLUXT=G3NTRP (FLXNTR, LATDIM, LTDIM, 2, BI, BJ, TMTRPl) 


FLUXT-FLUXT* 1000.0 
IF (FLUXT . LE . 0 . 0 ) THEN 

WRITE (6,*)'  BAD  FLUX  VALUE  CALCULATED  IN  SUBROUTINE  OPTERR' 
WRITE (6,*)'  UNABLE  TO  CONTINUE' 

WRITE (6,*)'  VM,  FLUX  =  CALVM, FLUXT 
STOP 
ENDIF 


WRITE(6,*)  ' E=' , energy, '  SAT  FLUX=' ,XSTFLX,  '  MODEL  FLUX=' , 

2  LOGIO (FLUXT) , '  ALAM=' ,ALAM( ENERGY) 

IF (STNDEV( ENERGY) . EQ. -1 . 0) THEN 
STNDEV (ENERGY) = (LOGIO (FLUXT) -XSTFLX) **2 
ELSE 

STNDEV (ENERGY) =STNDEV (ENERGY) 

1  +( (LOGIO (FLUXT) -XSTFLX) * *2) 

ENDIF 

NPTS (ENERGY) =NPTS (ENERGY) +1 

COEF (ENERGY) -COEF (ENERGY) + (LOGIO (FLUXT) -XSTFLX) 

WRITE (6,*)'  NOCHNL, STNDEV, COEF, ENERGY  ',NOCHNL-l, 

1  STNDEV (ENERGY) , COEF (ENERGY) , ENERGY, FLUXT, XSTFLX 

ENDIF 
CONTINUE 
XCHNCE-XCHNL 
IF(ISP.EQ.l)  THEN 

READ (99,*, END= 4  0  0 ) XCHNL , YEAR, DECDAY , LAT , LONG , ALT , MLT 
ELSE 

READ (98,*, END=4  00)  XCHNL , YEAR, DECDAY , LAT , LONG , ALT , MLT 
END  IF 

I F ( XCHNCE . NE . XCHNL ) THEN 

WRITE(6,*)'  NUMBER  OF  SATELLITE  ENERGY  CHANNELS  CHANGED  IN' 
WRITE(6,*)'  MID-RUN.  UNABLE  TO  COMPUTE  ERROR.  RETURNING  TO' 
WRITE (6,*)'  MAIN  PROGRAM.' 

RETURN 

ENDIF 

TIMCHK»TCONV2 (YEAR, DECDAY, YRCHCK, DYCHCK) 

WRITE (6,*)'  NPTS,TIMCHK,TIMTAG,ITM  ' ,NPTS, TIMCHK, TIMTAG (ITM+1) , 
1  ITM 


IF(TIMCHK.LT.TIMTAG(ITM+1) )GO  TO  200 


COMPUTE  STANDARD  DEVIATION  AND  TIME  SHIFT  FOR  THIS  TIME  INTERVAL 


400  CONTINUE 


C 


IF (ISP. EQ. MSP) 


THEN 
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MSM79230 
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msml.for 

DO  70  KNERGY=1, lEMAX 
ENERGY- (ABS (ALAM (KNERGY) ) *VMGEO) /lOOO . 00 
WRITE(6,*)'  KNERGY, STNDEV  KNERGY, STNDEV (KNERGY) 

IF (NPTS (KNERGY) .NE.0)THEN 

STNDEV (KNERGY) -SORT (STNDEV (KNERGY) /NPTS (KNERGY) ) 

WRITE(6,*)'  STANDARD  DEVIATION  (LOGIO)  =  ', STNDEV (KNERGY) , 

1  '  FOR  ENERGY  ENERGY,'  (KEV) ' 

COEF (KNERGY) -COEF (KNERGY) /NPTS (KNERGY) 

ERSHFT (KNERGY) -COEF (KNERGY) 

WRITE(6,*)'  PARALLEL  SHIFT  (LOGIO)  =  ', COEF ( KNERGY ) , 

1  '  FOR  ENERGY  ' , ENERGY, '  (KEV) ' 

ELSE 

ERSHFT (KNERGY) =0. 

ENDIF 

CONTINUE 

WRITE  STANDARD  DEVIATION  AND  SHIFT  TO  OUTPUT  DATA  SET 
IRDOUT-IREC+1 

WRITE (6,*)  'WRITING  INTO  SHFT  FILE  IRDOUT-' , IRDOUT, 

2  'IEMAX=',IEMAX, '  ERSHFT-' , ERSHFT 

CALL  WRTVEC (LUSHFT, IRDOUT, lEMAX, lEDIM, ALAM, THRSH, ERSHFT, IFLAV) 
END  IF 

CONTINUE 

15  CONTINUE 

RETURN 

END 

SUBROUTINE  WRTVEC (NOUNIT, IRDOUT, lEMAX, lEDIM, ALAM, THRSH, 

1  ERSHFT, IFLAV) 

SUBROUTINE  TO  WRITE 

ALAMS, THRESHOLD  ENERGIES,  AND  ERROR 
FOR  EACH  OF  THE  ENERGY  CHANNELS  IN  THIS  RUN 


DIMENSION  ALAM(IEDIM) , THRSH (lEDIM) , ERSHFT (lEDIM) , IFLAV (lEDIM) 
IRECL-4*IEDIM+1 

OPEN (UNIT-NOUNIT, ACCESS-' DIRECT' , RECL-IRECL, STATUS-' UNKNOWN' ) 
WRITE  THE  INFORMATION 

WRITE (NOUNIT, REC-IRDOUT) lEMAX, ALAM, THRSH, ERSHFT, IFLAV 
C 

CLOSE (NOUNIT) 

RETURN 

END 

C 

FUNCTION  CEXRAT (ISP,ENRG,RLOC, SSN,DKTIME, IRDK, INRGDK, ISOLDK, 

2  lONDK) 

C 

C  PROGRAMMER:  R.  W.  SPIRO  LAST  UPDATE:  05.09.90 

C 

C  PURPOSE:  FUNCTION  SUBPROGRAM  TO  RETURN  CHARGE  EXCHANGE  LOSS  RATE 
C  (SEC**(-1))  FOR  IONS  OF  SPECIES  ISP,  ENERGY  ENRG  (EV)  AT 

C  L-RLOC  (RE)  FOR  SUNSPOT  NUMBER  SSN.  THIS  ROUTINE  IS  BASED 

C  ON  A  TABLE  GENERATED  BY  JAMES  BISHOP  OF  U.  OF  MICHIGAN. 

C 

C  CALLING  PARAMETERS 

C  ISP  SPECIES  IDENTIFIER 

C  ISP-2  FOR  H+  IONS 

C  ISP-3  FOR  0+  IONS 


MSM79340 

MSM79350 

MSM79360 

MSM79370 

MSM79380 

MSM79390 

MSM79400 

MSM79410 

MSM79420 

MSM79430 

MSM79440 

MSM79450 

MSM79460 

MSM79470 

MSM79480 

MSM79490 

MSM79500 

MSM79510 

MSM79520 

MSM79530 

MSM79540 

MSM79550 

MSM79560 

MSM79570 

MSM79580 

MSM79590 

MSM79600 

MSM79610 

MSM79620 

MSM79630 

MSM79640 

MSM79650 

MSM79660 

MSM79670 

MSM79680 

MSM79690 

MSM79700 

MSM79710 

MSM79720 

MSM79730 

MSM79740 

MSM79750 

MSM79760 

MSM79770 

MSM79780 

MSM79790 

MSM79800 

MSM79810 

MSM79820 

MSM79830 

MSM79840 

MSM79850 

MSM79860 

MSM79870 

MSM79880 

MSM79890 

MSM79900 

MSM79910 

MSM79920 

MSM79930 

MSM79940 

MSM79950 

MSM79960 

MSM79970 
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ENRG  ENERGY  IN  EV 

RLOC  RADIAL  LOCATION  (RE) 

SSN  SUNSPOT  NUMBER 

DKTIME  TABLE  OF  ION  DECAY  TIMES 

IRDK  RADIAL  DIMENSION  OF  DKTIME  ARRAY 

INRGDK  ENERGY  DIMENSION  OF  DKTIME  ARRAY 

ISOLDK  SUNSPOT  NUMBER  DIMENSION  OF  DKTIME  ARRAY 

lONDK  NUMBER  OF  ION  SPECIES  IN  DKTIME  ARRAY 


PARAMETER  (IRSIZ-18, INRGSZ-13, ISOLSZ=2, IONSIZ=2) 

DIMENSION  DKTIME (IRDK, INRGDK, ISOLDK, lONDK) 

DIMENSION  ELGVEC (INRGSZ) ,  RVEC (IRSIZ) , SSNVEC (2) 

DATA  ELGVEC  /2 , 50, 2  .  "75,  3 . 00,  3 . 25,  3 . 50,  3 . 75,  4 . 00, 
2  4.25,4.50,4.75,5.00,5.25,5.50/ 

DATA  RVEC  /1 . 50, 2 . 00, 2 . 50 , 3 . 00, 

2  3.50,4.00,4.50,5.00, 

3  5.50,6.00,6.50,7.00, 

4  7.50,8.00,8.50,9.00, 

5  9.50,10.00/ 

DATA  SSNVEC  /O. 0,100./ 


CHECK  DIMENSIONS 

IF (IRSIZ. NE. IRDK. OR. INRGSZ. NE. INRGDK. OR. lONSIZ.NE.IONDK. OR. 

2  ISOLSZ.NE. ISOLDK)  THEN 

WRITE (6,*)  'DIMENSION  ERROR  IN  SUBROUTINE  CEXRAT' 

WRITE (6, * )  ' IRDK, INRGDK, lONDK, ISOLDK' , IRDK, INRGDK, lONDK, ISOLDK 
WRITE (6, *)  ' IRSIZ, INRGSZ, lONSIZ, ISOLSZ' , IRSIZ, INRGSZ, lONSIZ, 

2  ISOLSZ 

WRITE (6,*)  'STOPPING  PROGRAM  IN  CEXRAT' 

STOP 
END  IF 


WORK  WITH  LOGIO  OF  PARTICLE  ENERGY 
ENRGLG-ALOGIO (ENRG) 

ISPNDX=ISP-1 

FIND  BR  FOR  INTERPOLATION 
IF (RLOC. LE. RVEC (1 ) )  THEN 
BR-1 . 

ELSE  IF (RLOC. GT. RVEC (IRDK) )  THEN 
BR-IRDK 
ELSE 

DO  10  IR=1,IRDK-1 

IF (RLOC. LE. RVEC ( lR+1 ) )  THEN 

BR-IR+(RL0C-RVEC(IR) ) / (RVEC(IR+1)-RVEC(IR) ) 
GO  TO  20 
END  IF 

10  CONTINUE 
END  IF 


20  CONTINUE 


MSM79980 

MSM79990 

MSM80000 

MSM80310 

MSM80020 

MSM80030 

MSM80040 

MSM80050 

MSM80060 

MSMe0070 

MSM80080 

MSM80090 

MSM80100 

MSM80110 

MSM80120 

MSM80130 

MSM80140 

MSM80150 

MSM80160 

MSM80170 

MSM80180 

MSM80190 

MSM80200 

MSM80210 

MSM80220 

MSM80230 

MSM80240 

MSM80250 

MSM80260 

MSM80270 

MSM80280 

MSM80290 

MSM80300 

MSM80310 

MSM80320 

MSM80330 

MSM80340 

MSM80350 

MSM80360 

MSM80370 

MSM80380 

MSM80390 

MSM80400 

MSM80410 

MSM80420 

MSM80430 

MSM80440 

MSM80450 

MSM80460 

MSM80470 

MSM80480 

MSM80490 

MSM80500 

MSM80510 

MSM80520 

MSM80530 

MSM80540 

MSM80550 

MSM80560 

MfKS0570 

M£M80580 

MSH80590 

MSM80600 

MSM80610 
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FIND  BNRG  FOR  INTERPOLATION 

IF(ENRGLG.LE.ELGVEC(1) )  THEN 
BNRG-1 . 

ELSE  IF (ENRGLG.GT.ELGVEC (INRGDK) )  THEN 
BNRG=INRGDK 
ELSE 

DO  30  INRG=1, INRGDK-1 

IF{ENRGLG.LE.ELGVEC(INRG+1) )  THEN 

BNRG-INRG+ (ENRGLG-ELGVEC (INRG) ) / (ELGVEC (INRG+1) 
2  ELGVEC (INRG) ) 

GO  TO  40 
END  IF 

30  CONTINUE 
END  IF 


40  CONTINUE 


FIND  BSSN  FOR  INTERPOLATION 

BSSN-1.+(SSN-SSNVEC(1) ) / (SSNVEC (2) -SSNVEC (1 ) ) 

DECAYT  IS  DECAY  TIME  IN  SECONDS 

DECAYT»G3NTRP (DKTIME (1, 1, 1, ISPNDX) , IRDK, INRGDK, ISOLDK,BR, BNRG, 

2  BSSN) 

IF (ABS (DECAYT) .LT.l.E-20)  THEN 

WRITE (6,*)  'DECAYT  IS  LESS  THAN  l.E-20  SEC  IN  CEXRAT' 
WRITE(6,*)  'DECAYT-' , DECAYT, '  BR=',BR,'  BNRG-' , BNRG, ' BSSN-' , 

2  BSSN 

WRITE (6,*)  'ISP-', ISP,'  ENRG-' , ENRG, '  RLOC-' , RLOC, '  SSN=',SSN 
END  IF 

TO  GET  CHARGE  EXCHANGE  RATE  (SEC**9-1))  CEXRAT,  INVERT  DECAYT 
CEXRAT-1 . /DECAYT 
DEBUG  5.27.90 

WRITE(6,800)  ISP, ENRG , ENRGLG , RLOC , S  SN 
800  FORMAT (IX, ' ISP-' , 12, '  ENRG-' , E12 . 4 , '  ENRGLG-' , F7 . 4 , '  RLOC-', 

2  F7.4,'  SSN=',F7.4) 

WRITE (6, 802)  BR, BNRG, BSSN, DECAYT 

802  F0RMAT(1X,'BR»',F7.4,'  BNRG-' , F7 . 4, '  BSSN-' , F7 . 4 , '  DECAYT-', 

2  1PE12.4) 

END  DEBUG  5.27.90 


RETURN 

END 

SUBROUTINE  READDK(IRDK, INRGDK, ISOLDK, lONDK, DKTIME) 

PURPOSE:  SUBROUTINE  TO  READ  ION  CHARGE  EXCHANGE  DECAY  TABLE 

FURNISHED  BY  JAMES  BISHOP  OF  UNIV.  OF  MICHIGAN 

LAST  UPDATE:  05.10.90 

COMMON  LUNIT  CONTAINS  LOGICAL  UNIT  NUMBERS  FOR  INPUT  AND  OUTPUT 
COMMON  /LUNIT/LUERR, LUPIEN, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LUDK, LUFLXB, LUEBEG, LUSHFT, LUPIFX, LUEAVG, LUFLSM, LUFLX, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN, LUZMIN, LUALOC, 


MSM80620 

MSM80630 

MSM80640 

MSM80650 

MSM80660 

MSM80670 

MSM80680 

MSM80690 

MSM80700 

MSM80710 

MSM80720 

MSM80730 

MSM80740 

MSM80750 

MSM80760 

MSM80770 

MSM80780 

MSM80790 

MSM80800 

MSM80810 

MSM80820 

MSM80830 

MSM80840 

MSM80850 

MSM80860 

MSM80870 

MSM80880 

MSM80890 

MSM80900 

MSM80910 

MSM80920 

MSM80930 

MSM80940 

MSM80950 

MSM80960 

MSM80970 

MSM80980 

MSM80990 

MSM81000 

MSM81010 

MSM81020 

MSM81030 

MSM81040 

MSM81050 

MSM81060 

MSM81070 

MSM81080 

MSM81090 

MSM81100 

MSM81110 

MSM81120 

MSM81130 

MSM81140 

MSM81150 

MSM81160 

MSM81170 

MSM81180 

MSM81190 

MSM81200 

MSM81210 

MSM81220 

MSM81230 

MSM81240 

MSM81250 


msml.for 

LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 


DIMENSION  DKTIME (IRDK, INRGDK, ISOLDE, lONDK) 

READ (LUDK, 800)  DKTIME 
800  F0RMAT(8(1X,1PE9.3)) 

RETURN 

END 

SUBROUTINE  FLX2ET (LATDIM, LTDIM, lEDIM, lEMAX, ITMDIM, ITM, IFLAV, 
2  ALAM,ALMDEL,BNDLOC,VM, FLUX, ETA) 

PURPOSE:  CONVERT  FROM  PARTICLE  FLUX  (PART1CLES/CM**2/S)  TO 

INVARIANT  FLUX  ETA 


INPUT  CALLING 
LATDIM 
LTDIM 
lEDIM 
lEMAX 
ITMDIM 
ITM 
IFLAV 

ALAM 

ALMDEL 

BNDLOC 

VM 

FLUX 


PARAMETERS 

NUMBER  OF  LATITUDINAL  GRID  POINTS 
NUMBER  OF  LONGITUDINAL  GRID  POINTS 
MAXIMUM  NUMBER  OF  MODEL  ENERGY  CHANNELS 
ACTUAL  NUMBER  OF  MODEL  ENERGY  CHANNELS 
MAXIMUM  TIME  DEPTH 
TIME  LABEL 

VECTOR  GIVING  CHARGE  AND  MASS  SPECIES  OF  PARTICLES 

l=ELECTRONS,  2=H+  IONS,  3=0+  IONS 

ENERGY  INVARIANT  VECTOR 

ENERGY  CHANNEL  DIFFERENCE  VECTOR 

BOUNDARY  LOCATION  ARRAY 

FLUX  TUBE  VOLUME** (-2/3) 

PARTICLE  NUMBER  FLUX 


OUTPUT  PARAMETERS 

ETA  INVARIANT  NUMBER  FLUX  (PARTICLES/UNIT  MAGNETIC  FLUX) 


DIMENSION  IFLAVdEDIM)  ,ALAM(IEDIM)  ,  ALMDEL  (lEDIM) 

DIMENSION  VM (LATDIM, LTDIM, ITMDIM) , FLUX (LATDIM, LTDIM, lEDIM) 
DIMENSION  ETA (LATDIM, LTDIM, lEDIM) , BNDLOC (LTDIM, ITMDIM) 

DO  10  IE=1,IEMAX 

IF(IFLAV(IE) .EQ.2)  ATOMWT=l . 

IF(IFLAV(IE) .EQ.3)  ATOMWT=16. 

DO  20  J=l, LTDIM 

IB=IFIX (BNDLOC ( J, ITM) ) 

DO  30  I=IB, LATDIM 

IF(IFLAV(IE) .EQ.l)  THEN 

ETA(I, J,IE)=FLUX(I, J,IE)*ALMDEL(IE) /7.392E-16/ 

2  SQRT(ABS(ALAM(IE)))/VM(I,J,ITM) 

ELSE 

ETA (I, J, IE) =FLUX (I , J, IE) *ALMDEL (IE) *SQRT (ATOMWT) / 

2  1. 731E-17/SQRT(ABS (ALAM (IE) ) ) /VM(I, J, ITM) 

END  IF 

30  CONTINUE 

DO  35  1=1, IB-1 

ETA(I, J, IE)=ETA(IB,  J,  IE) 

35  CONTINUE 

20  CONTINUE 

10  CONTINUE 


MSM81260 

MSM81270 

MSM81280 

MSM81290 

MSM81300 

MSM81310 

MSM81320 

MSM81330 

MSMei340 

MSM81350 

MSM81360 

MSM81370 

MSM81380 

MSM81390 

MSM81400 

MSM81410 

MSM81420 

MSM81430 

MSM81440 

MSM81450 

MSM81460 

MSM81470 

MSM81480 

MSM81490 

MSM81500 

MSM81510 

MSM81520 

MSM81530 

MSM81540 

MSM81550 

MSM81560 

MSM81570 

MSM81580 

MSM81590 

MSM81600 

MSM81610 

MSM81620 

MSM81630 

MSM81640 

MSM81650 

MSM81660 

MSM81670 

MSM81680 

MSM81690 

MSM81700 

MSM81710 

MSM81720 

MSM81730 

MSM81740 

MSM81750 

MSM81760 

MSM81770 

MSM81780 

MSM81790 

MSM81800 

MSM81810 

MSM81820 

MSM81830 

MSM81840 

MSM81850 

MSM81860 

MSM81870 

MSM81880 

MSM81890 


msml.for 


RETURN 

END 

SUBROUTINE  ET2FLX (LATDIM, LTDIM, lEDIM, lEMAX, ITMDIM, ITM, IFLAV, 
2  ALAM,ALMDEL,BNDLOC,VM, FLUX, ETA) 

PURPOSE:  CONVERT  FROM  INVARIANT  FLUX  ETA  TO  FLUX  IN 

PARTICLES/CM* *2 /SA 


INPUT  CALLING 
LATDIM 
LTDIM 
lEDIM 
lEMAX 
ITMDIM 
ITM 
IFLAV 

ALAM 

ALMDEL 

BNDLOC 

VM 

FLUX 


PARAMETERS 

NUMBER  OF  LATITUDINAL  GRID  POINTS 
NUMBER  OF  LONGITUDINAL  GRID  POINTS 
MAXIMUM  NUMBER  OF  MODEL  ENERGY  CHANNELS 
ACTUAL  NUMBER  OF  MODEL  ENERGY  CHANNELS 
MAXIMUM  TIME  DEPTH 
TIME  LABEL 

VECTOR  GIVING  CHARGE  AND  MASS  SPECIES  OF  PARTICLES 

l=ELECTRONS,  2=H+  IONS,  3=0+  IONS 

ENERGY  INVARIANT  VECTOR 

ENERGY  CHANNEL  DIFFERENCE  VECTOR 

BOUNDARY  LOCATION  ARRAY 

FLUX  TUBE  VOLUME** (-2/3) 

PARTICLE  NUMBER  FLUX 


OUTPUT  PARAMETERS 


INVARIANT  NUMBER  FLUX  (PARTICLES/UNIT  MAGNETIC  FLUX) 


DIMENSION  IFLAV (lEDIM) , ALAM (lEDIM) , ALMDEL (lEDIM) 

DIMENSION  VM (LATDIM, LTDIM, ITMDIM) , FLUX (LATDIM, LTDIM, lEDIM) 
DIMENSION  ETA (LATDIM, LTDIM, lEDIM) , BNDLOC (LTDIM,  ITMDIM) 

DO  10  IE=1,IEMAX 

IF(IFLAV(IE) .EQ.2)  AT0MWT=1 . 

IF (IFLAV(IE) .EQ. 3)  ATOMWT=16. 

DO  20  J=l, LTDIM 

IB-IFIX (BNDLOC ( J, ITM) ) 

DO  30  I=IB, LATDIM 

IF(IFLAV(IE) .EQ.l)  THEN 

FLUXd,  J,IE)=ETA(I,  J,IE)*7.392E-16*VM(I,  J,ITM)* 

2  SQRT(ABS(ALAM(IE) ) ) /ALMDEL(IE) 

ELSE 

FLUX (I, J, IE) =ETA (I, J, IE) *VM (I,  J,  ITM) *1 . 731E-17* 

2  SORT (ABS (ALAM (IE) ) ) /ALMDEL (IE) /SQRT (ATOMWT) 

END  IF 

30  CONTINUE 

DO  35  1=1, IB-1 

FLUX (I, J, IE) =FLUX (IB, J, IE) 

35  CONTINUE 

20  CONTINUE 

10  CONTINUE 

RETURN 

END 


MSM81900 

MSM81910 

MSM81920 

MSM81930 

MSM81940 

MSM81950 

MSM81960 

MSM81970 

MSM81980 

MSM81990 

MSM82000 

MSM82010 

MSM82020 

MSM82030 

MSM82040 

MSM82050 

MSM82060 

MSM82070 

MSM82080 

MSM82090 

MSM82100 

MSM82110 

MSM82120 

MSM82130 

MSM82140 

MSM82150 

MSM82160 

MSM82170 

MSM82180 

MSM82190 

MSM82200 

MSM82210 

MSM82220 

MSM82230 

MSM82240 

MSM82250 

MSM822eO 

MSM82270 

MSM82280 

MSM82290 

MSM82300 

MSM82310 

MSM82320 

MSM82330 

MSM82340 

MSM82350 

MSM82360 

MSM82370 

MSM82380 

MSM82390 

MSM82400 

MSM82410 

MSM82420 

MSM82430 

MSM82440 

MSM82450 

MSM82460 

MSM82470 

MSM82480 


mi 

I  I 


Directory  DUCO: 

[ BALES . MSM . JULY_DELIV ] 

UtSf-  fft-  C-FtKLtp 

B0311011.DAT 

1 

303 11021. DAT ;l 

B03 11031. DAT ;1 

B0311051.DAT 

1 

BO311061.DAT; 1 

B03 11071. DAT ;1 

BO311091.DAT 

1 

B03 11101. DAT; 1 

B0311111.DAT; 1 

B0311131.DAT 

1 

B0311141.DAT; 1 

B0311151.DAT;1 

B0312011.DAT 

1 

B0312021.DAT; 1 

BO312031.DAT;l 

B0312051.DAT 

1 

B0312061.DAT;1 

B0312071.DAT;1 

B0312091.DAT 

1 

BO312101.DAT;l 

B0312111.DAT; 1 

B0312131.DAT 

1 

B0312141.DAT;1 

B0312151.DAT; 1 

BO313011.DAT 

1 

B0313021.DAT;1 

B0313031.DAT;1 

BO313051.DAT 

1 

B0313061.DAT;1 

B0313071.DAT;l 

B0313091.DAT 

1 

B0313101.DAT;1 

B0313111.DAT;1 

B0313131.DAT 

1 

B0313141.DAT;1 

B0313151.DAT;1 

B0314011.DAT 

1 

B0314021.DAT;l 

BO314031.DAT;l 

B0314051.DAT 

1 

B0314061.DAT;1 

B0314071.DAT;1 

BO314091.DAT 

1 

BO314101.DAT;l 

B0314111.DAT;l 

B0314131.DAT 

1 

B0314141.DAT;1 

B0314151.DAT;1 

B0315011.DAT 

1 

B0315021.DAT;1 

B0315031.DAT;1 

B0315051.DAT 

1 

B0315061.DAT; 1 

B0315071.DAT;1 

BO315091.DAT 

1 

B03 15101. DAT ;1 

B0315111.DAT; 1 

B0315131.DAT 

1 

B03 15141. DAT ;1 

B03 15151. DAT ;l 

BO316011.DAT 

1 

B0316021.DAT; 1 

BO316031.DAT;l 

B0316051.DAT 

1 

B0316061.DAT; 1 

BO316071.DAT; 1 

B0316091.DAT 

1 

B0316101.DAT;1 

B0316111.DAT;1 

B0316131.DAT 

1 

B0316141.DAT;1 

B0316151.DAT; 1 

B0317011.DAT 

1 

B0317021.DAT;1 

B0317031.DAT; 1 

B0317051.DAT 

1 

B0317061.DAT;1 

B0317071.DAT;1 

B0317091.DAT 

1 

B0317101.DAT;1 

B0317111.DAT;1 

B0317131.DAT 

1 

B0317141.DAT;1 

B0317151.DAT;1 

B0318011.DAT 

1 

B0318021.DAT; 1 

BO318031.DAT;l 

BO318051.DAT 

1 

B0318061.DAT;1 

BO318071.DAT;l 

B0318091.DAT 

1 

B0318101.DAT;l 

B03 18111. DAT ;1 

B0318131.DAT 

1 

B0318141.DAT; 1 

B0318151.DAT;1 

B0321011.DAT 

1 

B0321021.DAT;l 

B032 1031. DAT ;1 

B0321051.DAT 

1 

B0321061.DAT;1 

B0321071.DAT;l 

B0321091.DAT 

1 

B0321101.DAT;l 

B032 1111. DAT ;l 

B0321131.DAT 

1 

B0321141.DAT; 1 

B0321151.DAT;l 

B0322011.DAT 

1 

B0322021.DAT;1 

B0322031.DAT; 1 

B0322051.DAT 

1 

B0322061.DAT; 1 

BO322071.DAT;l 

B0322091.DAT 

1 

B0322101.DAT;l 

B0322111.DAT;1 

B0322131.DAT 

1 

B0322141.DAT;1 

B0322151.DAT;1 

B0323011.DAT 

1 

B0323021.DAT;1 

BO323031.DAT;l 

BO323051.DAT 

1 

B0323061.DAT;1 

BO323071.DAT;l 

BO323091.DAT 

1 

B0323101.DAT;1 

B0323111.DAT;1 

B0323131.DAT 

1 

B0323141.DAT; 1 

B0323151.DAT; 1 

BO324011.DAT 

1 

B0324021.DAT; 1 

BO324031.DAT;l 

B0324051.DAT 

1 

BO324061.DAT; 1 

BO324071.DAT;l 

B0324091.DAT 

1 

B0324101.DAT;1 

B0324111.DAT;1 

B0324131.DAT 

1 

B0324141.DAT;1 

B0324151.DAT;1 

BO325011.DAT 

1 

BO325021.DAT;l 

B0325031.DAT; 1 

B0325051.DAT 

1 

B0325061.DAT;1 

B0325071.DAT;1 

B0325091.DAT 

1 

B0325101.DAT;1 

B0325111.DAT;1 

B0325131.DAT 

1 

B0325141.DAT;1 

B0325151.DAT;l 

BO326011.DAT 

1 

B0326021.DAT;1 

BO326031.DAT;l 

B0326051.DAT 

1 

B0326061.DAT;1 

BO326071.DAT; 1 

BO326091.DAT 

1 

B0326101.DAT;1 

B0326111.DAT;1 

B0326131.DAT 

1 

B0326141.DAT;1 

B0326151.DAT;1 

B0327011.DAT 

1 

B0327021.DAT; 1 

B0327031.DAT;1 

B0311041.DAT; 1 

B03 11081. DAT; 1 

B0311121.DAT; 1 

B0311161.DAT; 1 

B0312041.DAT; 1 

B0312081.DAT; 1 

B0312121.DAT;1 

B0312161.DAT; 1 

B0313041.DAT; 1 

B0313081.DAT; 1 

B0313121.DAT;1 

B0313161.DAT; 1 

BO314041.DAT;l 

BO314081.DAT71 

B0314121.DAT;1 

B0314161.DAT; 1 

BO315041.DAT; 1 

BO315081.DAT71 

B0315121.DAT;1 

B0315161.DAT;1 

BO316041.DAT; 1 

B03 16081. DAT ;l 

B0316121.DAT; 1 

BO3I6I6I.DAT7I 

BO317041.DAT;l 

BO317081.DAT; 1 

B0317121.DAT; 1 

B0317161.DAT; 1 

B0318041.DAT; 1 

B0318081.DAT;l 

B0318121.DAT;1 

BO3I8I6I.DAT7I 

BO321041.DAT;l 

BO321081.DAT;l 

B0321121.DAT;1 

B0321161.DAT;l 

B0322041.DAT; 1 

B0322081.DAT; 1 

B0322121.DAT; 1 

B0322161.DAT; 1 

B0323041.DAT;1 

BO323081.DAT;l 

B0323121.DAT; 1 

B0323161.DAT;1 

B0324041.DAT;1 

B0324081.DAT;1 

B0324121.DAT;1 

B0324161.DAT; 1 

BO325041.DAT;l 

B0325081.DAT;1 

B0325121.DAT;1 

B0325161.DAT; 1 

B0326041.DAT;1 

B0326081.DAT;1 

B0326121.DAT;1 

B0326161.DAT;1 

B0327041.DAT; 1 


B0327051.DAT 

B0327091.DAT 

B0327131.DAT 

B0328011.DAT 

B0328051.DAT 

E0328091.DAT 

B0328131.DAT 

BO331011.DAT 

B0331051.DAT 

B0331091.DAT 

B0331131.DAT 

B0332011.DAT 

B0332051.DAT 

B0332091.DAT 

B0332131.DAT 

B0333011.DAT 

B0333051.DAT 

B0333091.DAT 

B0333131.DAT 

B0334011.DAT 

B0334051.DAT 

B0334091.DAT 

B0334131.DAT 

B0335011.DAT 

B0335051.DAT 

B0335091.DAT 

B0335131.DAT 

B0336011.DAT 

B0336051.DAT 

B0336091.DAT 

B0336131.DAT 

B0337011.DAT 

B0337051.DAT 

B0337091.DAT 

B0337131.DAT 

B0338011.DAT 

B0338051.DAT 

B0338091.DAT 

B0338131.DAT 

B0341011.DAT 

B0341051.DAT 

B0341091.DAT 

B0341131.DAT 

B0342011.DAT 

B0342051.DAT 

B0342091.DAT 

B0342131.DAT 

B0343011.DAT 

B0343051.DAT 

BO343091.DAT 

B0343131.DAT 

B0344011.DAT 

B0344051.DAT 

BO344091.DAT 

B0344131.DAT 

B0345011.DAT 

B0345051.DAT 

B0345091.DAT 

B0345131.DAT 

B0346011.DAT 


B0327061.DAT 

B0327101.DAT 

B0327141.DAT 

B0328021.DAT 

B0328061.DAT 

B0328101.DAT 

B0328141.DAT 

B0331021.DAT 

B0331061.DAT 

B0331101.DAT 

B0331141.DAT 

B0332021.DAT 

B0332061.DAT 

BO332101.DAT 

B0332141.DAT 

B0333021.DAT 

B0333061.DAT 

B0333101.DAT 

B0333141.DAT 

BO334021.DAT 

B0334061.DAT 

B0334101.DAT 

B0334141.DAT 

B0335021.DAT 

B0335061.DAT 

B0335101.DAT 

B0335141.DAT 

B0336021.DAT 

B0336061.DAT 

B0336101.DAT 

B0336141.DAT 

B0337021.DAT 

B0337061.DAT 

B0337101.DAT 

B0337141.DAT 

B0338021.DAT 

BO338061.DAT 

B0338101.DAT 

B0338141.DAT 

B0341021.DAT 

BO341061.DAT 

BO341101.DAT 

B0341141.DAT 

B0342021.DAT 

BO342061.DAT 

BO342101.DAT 

B0342141.DAT 

B0343021.DAT 

B0343061.DAT 

B0343101.DAT 

B0343141.DAT 

B0344021.DAT 

B0344061.DAT 

B0344101.DAT 

B0344141.DAT 

B0345021.DAT 

B0345061.DAT 

B0345101.DAT 

B0345141.DAT 

B0346021.DAT 


1 

1 

1 

1 

1 

1 

1 

1 

JL 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 
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1 
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B0327071.DAT;1 

B0327111.DAT;1 

B0327151.DAT;1 

B0328031.DAT; 1 

BO328071.DAT;l 

B0328111.DAT;1 

B0328151.DAT;1 

BO331031.DAT; 1 

B0331071.DAT; 1 

B0331111.DAT; 1 

B0331151.DAT;l 

BO332031.DAT;l 

B0332071.DAT; 1 

B0332111.DAT; 1 

B0332151.DAT;1 

BO333031.DAT;l 

BO333071.DAT;l 

B0333111.DAT;1 

B0333151.DAT;1 

B0334031.DAT;1 

B0334071.DAT;1 

B0334111.DAT;1 

B0334151.DAT; 1 

B0335031.DAT;1 

B0335071.DAT; 1 

B0335111.DAT;1 

B0335151.DAT; 1 

B0336031.DAT;1 

B0336071.DAT; 1 

B0336111.DAT;1 

B0336151.DAT; 1 

BO337031.DAT; 1 

B0337071.DAT;l 

B0337111.DAT;1 

B0337151.DAT;l 

B0338031.DAT;1 

B0338071 .DAT;l 

B0338111.DAT;l 

B0338151.DAT; 1 

BO341031.DAT;l 

B0341071.DAT;1 

B034 1111. DAT ;1 

B0341151.DAT; 1 

B0342031.DAT;1 

BO342071.DAT;l 

B0342111.DAT; 1 

B0342151.DAT;1 

BO343031.DAT;l 

B0343071.DAT;1 

B0343111.DAT;1 

B0343151.DAT;1 

BO344031.DAT;l 

BO344071.DAT;l 

B0344111.DAT;1 

B0344151.DAT; 1 

B0345031.DAT; 1 

BO345071.DAT;l 

B0345111.DAT;1 

B0345151.DAT; 1 

BO346031.DAT;l 


B0327081 

B0327121 

B0327161 

BO328041 

B0328081 

B0328121 

B0328161 

BO331041 

B0331081 

B0331121 

B0331161 

B0332041 

B0332081 

B0332121 

B0332161 

B0333041 

B0333081 

B0333121 

B0333161 

B0334041 

B0334081 

B0334121 

B0334161 

B0335041 

B0335081 

B0335121 

B0335161 

BO336041 

B0336081 

B0336121 

B0336161 

BO337041 

B0337081 

B0337121 

B0337161 

BO338041 

B0338081 

B0338121 

B0338161 

B0341041 

B0341081 

B0341121 

B0341161 

BO342041 

BO342081 

B0342121 

B0342161 

BO343041 

BO343081 

B0343121 

B0343161 

B0344041 

BO344081 

B0344121 

B0344161 

BO345041 

BO345081 

B0345121 

B0345161 

B0346041 


•  DAT 

•  DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 
.DAT 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


h 


^03  4  6051.  DAT 
^0346091.  DAT 
B034ei31.DAT 
I&O347011.DAT 
P0347051.DAT 
B0347091.DAT 
gB0347131.DAT 
KJO351011.DAT 
•bO351051.DAT 
B0351091.DAT 

IB0351131.DAT 
B0352011.DAT 
B0352051.DAT 

IB0352091.DAT 
B0352131.DAT 
B0353011.DAT 
B0353051.DAT 

IB0353091.DAT 
B0353131.DAT 
B0354011.DAT 
B0354051.DAT 

IB0354091.DAT 
B0354131.DAT 
BO355011.DAT 

tB0355051.DAT 
B0355091.DAT 
B0355131.DAT 
B0356011.DAT 

IB0356051.DAT 
B0356091.DAT 
B0356131.DAT 
^  B0357011.DAT 
IbO357051.DAT 
Ib0357091.DAT 
B0357131.DATi 
DIRECTORY. LIS ;l 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


I 


Total  of  609  files 


B0346061.DAT 

B0346101.DAT 

B0346141.DAT 

B0347021.DAT 

B0347061.DAT 

B0347101.DAT 

B0347141.DAT 

B0351021.DAT 

B0351061.DAT 

B0351101.DAT 

B0351141.DAT 

B0352021.DAT 

BO352061.DAT 

B0352101.DAT 

B0352141.DAT 

B0353021.DAT 

BO353061.DAT 

B0353101.DAT 

B0353141.DAT 

B0354021.DAT 

B0354061.DAT 

B0354101.DAT 

B0354141.DAT 

B0355021.DAT 

B0355061.DAT 

B0355101.DAT, 

B0355141.DAT 

B0356021.DAT 

B0356061.DAT 

B0356101.DAT 

B0356141.DAT 

B0357021.DAT 

B0357061.DAT 

B0357101.DAT 

B0357141.DAT 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


B0346071.DAT 

B0346111.DAT 

B0346151.DAT 

B0347031.DAT 

B0347071.DAT 

B0347111.DAT 

B0347151.DAT 

B0351031.DAT 

BO351071.DAT 

B0351111.DAT 

B0351151.DAT 

B0352031.DAT 

BO352071.DAT 

B0352111.DAT 

B0352151.DAT 

BO353031.DAT 

B0353071.DAT 

B0353111.DAT 

B0353151.DAT 

BO354031.DAT 

B0354071.DAT 

B0354111.DAT 

B0354151.DAT 

B0355031.DAT 

B0355071.DAT 

B0355111.DAT 

B0355151.DAT, 

BO356031.DAT 

B0356071.DAT, 

B0356111.DAT 

B0356151.DAT 

B0357031.DAT 

BO357071.DAT 

B0357111.DAT 

B0357151.DAT 


1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 

1 


BO346081.DAT;l 
B0346121.DAT; 1 
B0346161.DAT; 1 
30347041. DAT; 1 
B0347081.DAT;1 
B0347121.DAT; 1 
B0347161.DAT; 1 
B0351041.DAT;1 
B0351081.DAT; 1 
B0351121.DAT;1 
B0351161.DAT;1 
B0352041.DAT;1 
BO352081.DAT;l 
B0352121.DAT; 1 
B0352161.DAT;1 
B0353041.DAT;1 
BO353081.DAT;l 
B0353121.DAT; 1 
B0353161.DAT;1 
B0354041.DAT;1 
B0354081.DAT; 1 
B0354121.DAT; 1 
B0354161.DAT; 1 
BO355041.DAT;l 
B0355081.DAT; 1 
B0355121.DAT; 1 
B0355161.DAT;1 
B0356041.DAT; 1 
B0356081.DAT;1 
B0356121.DAT;1 
B0356161.DAT;1 
BO357041.DAT; 1 
B0357081.DAT;1 
B0357121.DAT; 1 
B0357161.DAT; 1 


} 


I 


Appendix  C 


Appendix  C  is  attached  separately  as  a  computer  listing. 


Appendix  D 


mapint.cbm 

$define  sys$input  tt 
! $def ine  sys$output  tt 
$define  bfield  [-.bfields] 

$define  forOOS  msmout.dat 
$de£ine  £or014  ashi£t.dat 
$de£ine  £or015  a£lux.dat 
$de£ine  £or016  avm.dat 
$de£ine  £or017  abndloc.dat 
$de£ine  £or018  axmin.dat 
$de£ine  £or019  aymin.dat 
$de£ine  £or020  azmin.dat 
$de£ine  £or044  aupdat.dat 
$run  mapint 


o  o  o  o 


mapint.for 


PROGRAM  MSMMAP 

VERSION  OF  4/23/90 
PROGRAMMED  BY  R.  V.  HILMER 

REQUIRES  LINKAGE  WITH  BFIELD  MODEL  SUBROUTINES, 
SUBROUTINES  FNDBRK,  AND  B-MATRIX  DATA  FILES 

PURPOSE-  THIS  PROGRAM  COLLECTS  MAGNETOSPHERIC  SPECIFICATION 
MODEL  INPUTS  AND  AN  ARBITRARY  GSM  STARTING  POINT, 
VALIDATES  THE  INPUTS  AND  FINDS  THE  POINT  ON  THE  MSM 
CALCULATION  SURFACE  WHICH  IS  MAGNETICALLY  CONNECTED 
TO  THE  GSM  STARTING  POINT. 

IT  THEN  INTERPOLATES  IN  SPACE,  TIME  AND  ENERGY  TO 
GET  THE  FLUXES  AT  THE  MAPPED  POINT. 

VARIABLES-  FTILT:  DIPOLE  TILT  ANGLE  (DEGREES,  POSITIVE  FOR 

NORTHERN  HEMISPHERE  SUMMER) 

FSTDFF:  MAGNETOPAUSE  STAND-OFF  DISTANCE  (RE) 

FDST:  MAGNETIC  ACTIVITY  INDEX  DST  (NT) 

FEQEDG:  DIPOLE  LAT.  OF  MIDNIGHT  EQUATORWARD  DIFFUSE 
AURORA  BOUNDARY  (DEG) . 

FCLPSE:  MAGNETOTAIL  FIELD  COLLAPSE  INDICATOR 
XSTRT, YSTRT, ZSTRT:  MAGNETIC  TRACING  START  POINT  (GSM) 
IVALID:  INDICATES  IF  INSERTED  INPUTS  ARE  WITHIN  VALID 
RANGES.  (1  =  YES,  0  =  NO) 

XMAP,YMAP,ZMAP:  MAGNETIC  MAPPING  POINT  ON  THE  MSM 
COMPUTATIONAL  SURFACE  (GSM) . 

SUBROUT I NES -MAP TRK:  DETERMINES  THE  MAGNETIC  FIELD  MAPPING 

CONNECTING  AN  ARBITRARY  POINT  IN  SPACE  TO  THE  MSM 
COMPUTIONAL  SURFACE.  USES  INTERPOLATION  SCHEME 
INVOLVING  PRECALCULATED  INTERNAL  MODEL  PARAMETER 
SETS  TO  FIND  THE  MAPPING  FOR  ARBITRARY  MSM  INPUT. 
VALID:  CHECKS  TO  SEE  IF  EXTERNAL  INPUT  PARAMETERS 
AND  TRACING  START  POINT  ARE  VALID. 

READ3D:  READS  DATA  FILES  FOR  FLUX  CALCULATION. 

LOCATE:  FINDS  THE  INTERPOLATED  POINT  ON  A 

2 -DIMENSIONAL  GRID. 

CHECK:  CHECKS  THAT  THE  INPUT  TIMES  ARE  REASONABLE. 

TCHECK:  LOCATES  THE  2  RECORDS  WHICH  SPAN  THE  TIME 

REQUESTED . 

RDVEC:  READS  THE  HEADER  VECTOR  OF  THE  FLUX  FILES 

SETALM:  SETS  UP  THE  INVARIANT  ENERGY  ARRAY 

FUNCTIONS:  G3NTRP;  3-DIMENSIONAL  INTERPOLATION  ROUTINE 


LOCATE: 

CHECK: 

TCHECK: 


FUNCTIONS: 


RDVEC :  ] 

SETALM: 
G3NTRP ; 


MAPOOOlO 

MAP00020 

MAP00030 

MAP00040 

MAP00050 

MAP00060 

MAP00070 

MAP00080 

MAP00090 

MAPOOlOO 

MAPOOllO 

MAP00120 

MAP00130 

MAP00140 

MAP00150 

MAP00160 

MAP00170 

MAP00180 

MAP00190 

MAP00200 

MAP00210 

MAP00220 

MAP00230 

MAP00240 

MAP00250 

MAP00260 

MAP00270 

MAP00280 

MAP00290 

MAP00300 

MAP00310 

MAP00320 

MAP00330 

MAP00340 

MAP00350 

MAP00360 

MAP00370 

MAP00380 

MAP00390 

MAP00400 

MAP00410 


I 

0 
0 


PARAMETER  (LATDIM=62, LTDIM-51, IEDIM=30, ITMDIM=50,  NAUGEL=28)  MAP00420 

DIMENSION  R(LATDIM,LTDIM),BNDL0C(LTDIM,2),P(LATDIM,LTDIM),  MAP00430 

VM(LATDIM,LTDIM, 2) , FLUX (LATDIM, LTDIM, lEDIM)  ,  ALAM (lEDIM) ,  MAP00440 

ALMDEL(IEDIM) , ID (20) , RID (20) , THRSH (lEDIM)  ,  ERSHFT (lEDIM) ,  MAP00450 

XMIN( LATDIM, LTDIM, 2) , YMIN (LATDIM, LTDIM, 2) , ZMIN (LATDIM, LTDIM, 2) ,  MAP00460 
AUGPAR (NAUGEL) , AGPARl (NAUGEL) , FLUXl (LATDIM, LTDIM, lEDIM) ,  MAP00470 

ISTART(3) ,IFLAV(IEDIM) ,FLXOUT(2)  MAP00480 

CHARACTER*80  CHID  MAP00490 


PI-ATAN2(0.,-1.) 

THE  INTERACTIVE  PORTION  OF  THE  PROGRAM  CHECKS  FOR  CORRECT  TIME 
ENTRIES  THROUGH  SUBROUTINE  CHECK. 

100  WRITE (6,*)'  ENTER  LAST  2  DIGITS  OF  YEAR  AND  JULIAN  DAY  ' 
READ ( 5 , * ) I YEAR, IDAY 

WRITE (6,*)'  ENTER  HOUR,  MINUTE,  AND  SECONDS  ' 

READ (5, *) IHOUR, MINUTE, ISCNDS 

CALL  CHECK (lYEAR, IDAY, IHOUR, MINUTE, ISCNDS, IFLAG) 
IFdFLAG.EQ.  1)THEN 
WRITE (6, *) 

WRITE (6,*)'  INCORRECT  INPUT.  DO  YOU  WANT  TO  TRY  AGAIN?' 


MAP00500 
MAP00510 
MAP00520 
MAP00530 
MAP00540 
MAP00550 
MAP00560 
MAt  1570 
MAP(;.  ;80 
MAP00590 
MAP00600 
MAP00610 
MAP00620 


C  WRITE(6, *) 'ALAM' ,ALAM, 


mapint.for 

THRSH' , THRSH, ' ERSHFT' , ERSHFT, 


IFLAV' , IFLAV 


CALL  READ3D(15, 'FLUX  ' , IREC, LATDIM, LTDIM, lEMAX, ITMDIM, ID, RID, 
1  CHID, FLUX) 

CALL  READ3D{15, 'FLUX  ', IREC+1, LATDIM, LTDIM, lEMAX, ITMDIM, ID, 

1  RID,  CHID, FLUXl) 


C 

C 

C 

C 


IF{ {ID(8) .NE. LATDIM) .OR. (ID(9) . NE . LTDIM) ) THEN 
WRITE (6,*) 

WRITE (6,*)'  INCORRECT  PARAMETERS  FOR  GRID-STOPPING  PROGRAM' 
WRITE(6,*)'  ID(8)  =  ',ID(8),'  LATDIM  =  ', LATDIM 
WRITE  (6,*)'  IDO)  “  ',ID(9),'  LTDIM  =  ',  LTDIM 
WRITE (6,*) 

STOP 

ENDIF 

CALL  READ3D(16,'VM  ', IREC, LATDIM, LTDIM, 1 , ITMDIM, ID, RID, CHID, 

1  VM(1,1,1)) 

CALL  READ3D(16, 'VM  ', IREC+1, LATDIM, LTDIM, 1, ITMDIM, ID, RID, CHID, 

1  VM(1,1,2)) 

CALL  READ3D (17, ' BNDLOC' , IREC, LTDIM, 1, 1 , ITMDIM, ID, RID, CHID, 

1  BNDLOC (1,1)) 

CALL  READ3D (17, 'BNDLOC' , IREC+1, LTDIM, 1,1, ITMDIM, ID, RID, CHID, 

1  BNDLOC (1,2)) 

CALL  READ3D(18, 'XMIN  ', IREC, LATDIM, LTDIM,  1,  ITMDIM, ID, RID, 

1  CHID, XMIN (1, 1, 1) ) 

CALL  READ3D(18, 'XMIN  ', IREC+1 , LATDIM, LTDIM, 1 , ITMDIM, ID, RID, 

1  CHID, XMINd,  1,2)  ) 

CALL  READ3D(19, 'YMIN  ', IREC, LATDIM, LTDIM, 1, ITMDIM, ID, RID, 

1  CHID,YMIN(1,1,1) ) 

CALL  READ3D(19,'YMIN  ', IREC+1, LATDIM, LTDIM, 1, ITMDIM, ID, RID, 

1  CHID,YMIN(1,1,2) ) 

CALL  READ3D(20, 'ZMIN  ', IREC, LATDIM, LTDIM, 1, ITMDIM, ID, RID, 

1  CHID, ZMIN (1, 1, 1) ) 

CALL  READ3D(20, 'ZMIN  ', IREC+1 , LATDIM, LTDIM, 1, ITMDIM, ID, RID, 

1  CHID,ZMIN(1,1,2) ) 

SET  UP  THE  TIME  INTERPOLATION  FOR  THE  B-FIELD  COMPONENTS  AND 
CALCULATE  RADIUS  AND  LOCAL  TIME  ARRAYS 


TIME- (FLOAT (IHOUR) *3600.0)  +  (FLOAT (MINUTE) *60 . 0 )  +  FLOAT (ISCNDS) 
TIME1-(AUGPAR (3) *3600.0)  +  (AUGPAR(4) *60 . 0)  +  AUGPAR(5) 
TIME2-(AGPAR1 (3) *3600.0)  +  (AGPARl (4) *60. 0)  +  AGPARl (5) 

TIMTRP  =( (TIME-TIMED / (TIME2-TIME1) )  +1.0 
C  WRITE(6,*) 'TIME,TIMEl,TIME2,TIMTRi  , TIME, TIMEl , TIME2, TIMTRP 
DO  400  I-l, LATDIM 
DO  450  J-1, LTDIM 

XNTRP-G3NTRP (XMIN, LATDIM, LTDIM, 2, FLOAT (I) , FLOAT ( J) , TIMTRP) 
YNTRP-G3NTRP (YMIN, LATDIM, LTDIM, 2, FLOAT (I) , FLOAT ( J) , TIMTRP) 
ZNTRP-G3NTRP ( ZMIN, LATDIM, LTDIM, 2 , FLOAT ( I ) , FLOAT ( J) , TIMTRP ) 

R(I, J)-SQRT(XNTRP**2  +  YNTRP**2  +  ZNTRP**2) 

IF( (XNTRP.EQ.0.0) .AND. (YNTRP . EQ. 0 . 0) ) THEN 
P(I,  J)-0.0 
ELSE 

P (I ,  J) -ATAN2 (YNTRP , XNTRP ) 

IF(P(I, J) .LT.0.0)P(I, J)=P(I, J)+  2.0*PI 
ENDIF 

450  CONTINUE 

400  CONTINUE 

C  WRITE (6,*)'  IREC  ' , IREC 

C 

C  SET  UP  INVARIANT  ARRAYS  FOR  THE  FLUX  CALCULATIONS 
C 


CALL  SETALM(ALAM, lEMAX, lEDIM, IFLAV, ALMDEL) 
10  CONTINUE 


MAP01310 
MAP01320 
MAP01330 
MAP01340 
MAP01350 
MAP01360 
MAP01370 
MAP01380 
MAP01390 
MAP01400 
MAP01410 
MAP01420 
MAP01430 
MAP01440 
MAP01450 
MAP01460 
MAP01470 
MAP01480 
MAP01490 
MAP01500 
MAP01510 
MAP01520 
MAPOl "30 
MAP01540 
MAP01550 
MAP01560 
MAP01570 
MAP01580 
MAP01590 
MAP01600 
MAP01610 
MAP01620 
MAP01630 
MAP01640 
MAP01650 
MAP01660 
MAP01670 
MAP01680 
MAP01690 
MAP01700 
MAP01710 
MAP01720 
MAP01730 
MAP01740 
MAP01750 
MAP01760 
MAP01770 
MAP01780 
MAP01790 
MAP01800 
MAP01810 
MAP01820 
MAP01830 
MAP01840 
MAP01850 
MAP01860 
MAP01870 


mapini.for 


WRITE (6,*)'  ENTER  0  TO  STOP,  ANY  OTHER  NUMBER  TO  TRY  AGAIN.' 
REAI3(5,*)IANSW 
WRITE <6,  *) 

IF(IANSW.EQ.O)STOP 
GO  TO  100 
ENDIF 
IREC-1 

THIS  PORTION  OF  THE  CODE  SEARCHES  THE  OUTPUT  DATA  BASE  TO  FIND  THE 
2  TIMES  CLOSEST  TO  THE  INPUT  TIME. 

3  CALL  READ3D{44, 'UPDATE', IREC,NAUGEL,1,1,ITMDIM,ID,RID,CHID, 

1  AUGPAR) 

WRITE (6,*)'  IREC,  ID  ' , IREC, ID 
IF{IREC.EQ.1)THEN 
I START ( 1 ) “AUGPAR ( 1 ) 

I START ( 2 ) -AUGPAR ( 2 ) 

ISTART(3)=AUGPAR(3) *3600  +  AUGPAR(4)*60  +  AUGPAR(5) 

ITMMAX-ID(IO) 

IEMAX=ID(9) 

ENDIF 

IF ( IREC+1 . GT . ITMMAX) THEN 
WRITE (6, *) 

WRITE (6,*)'  END  OF  FILE  ENCOUNTERED  WITHOUT  FINDING  THE  TIME', 

1  '  YOU  REQUESTED.' 

WRITE (6,*)'  ENTER  0  TO  STOP,  ANY  OTHER  NUMBER  TO  TRY  AGAIN.' 
READ(5,*)IANSW 
IF(IANSW.EQ.0)STOP 
GO  TO  100 
ENDIF 

CALL  READ3D (44,' UPDATE' , IREC+1 , NAUGEL, 1,1, ITMDIM, ID, RID, CHID, 

1  AGPARl ) 

CALL  TCHECK (lYEAR, IDAY, IHOUR, MINUTE, ISCNDS, AUGPAR, AGPARl , 

1  NAUGEL, IFLAG,ISTART) 

IF(IFLAG.EQ.1)THEN 
IREC-IREC+1 
GO  TO  200 
ENDIF 

INPUT  SATELLITE  ENERGY  IN  KEV.  THIS  IS  CHECK  TO  BE  GREATER  THAN  0 
AND  CONVERTED  TO  INVARIANT  ENERGY,  ALAM,  THE  PROGRAMS  BASIC 
ENERGY  UNIT.  ALSO  PARTICLE  TYPE  IS  REQUESTED  AND  CHECKED  TO  BE 
BETWEEN  1  AND  3  { 1-ELECTRONS, 2-H+,  3=0+) 

3  WRITE (6,*)'  INPUT  ENERGY  (KEV)  AND  1  FOR  ELECTRONS,  2  FOR  H+,  ' 
WRITE (6,*)'  OR  3  FOR  0+' 

READ ( 5, * ) ENERGY, JFLAV 
IF ( (JFLAV.lt. 1) .OR. (JFLAV.GT.3) )THEN 
WRITE (6,*) 

WRITE (6,*)'  INCORRECT  INPUT  FOR  PARTICLE  TYPE.  PLEASE  RE-ENTER.' 
WRITE (6, *) 

GO  TO  300 
ENDIF 

I F ( ENERGY . LE . 0 ) THEN 
WRITE (6,*) 

WRITE (6,*)'  ENERGY  LESS  THAN  0.  PLEASE  RE-ENTER.' 

WRITE (6,*) 

GO  TO  300 
ENDIF 

READ  INPUT  FILES  NEEDED  FOR  INTERPOLATING 


CALL  RDVEC  (14 , IREC, lEMAX, lEDIM, ALAM, THRSH, ERSHFT, IFLAV) 


MAP00630 

MAP00640 

MAP00650 

MAP00660 

MAP00670 

MAP00680 

MAP00690 

MAP00700 

MAP00710 

MAP00720 

MAP00730 

MAP00740 

MAP00750 

MAP00760 

MAP00770 

MAP00780 

MAP00790 

MAP00800 

MAP00810 

MAP00820 

MAP00830 

MAP00840 

MAP00850 

MAP00860 

MAP00870 

MAP00880 

MAP00890 

MAP00900 

MAP00910 

MAP00920 

MAP00930 

MAP00940 

MAP00950 

MAP00960 

MAP00970 

MAP00980 

MAP00990 

MAPOIOOO 

MAPOlOlO 

MAP01020 

MAP01030 

MAP01040 

MAP01050 

MAP01060 

MAP01070 

MAP01080 

MAP01090 

MAPOllOO 

MAPOlllO 

MAP01120 

MAP01130 

MAP01140 

MAP01150 

MAP01160 

MAP01170 

MAP01180 

MAP01190 

MAP01200 

MAP01210 

MAP01220 

MAP01230 

MAP01240 

MAP01250 


oooo  oooo 


mapint.for 

ENDIF 

550  CONTINUE 

IF{XLO.EQ.-1.0)THEN 
WRITE (6,*) 

WRITE (6,*)'  ENERGY  NOT  CALCULATED  FOR  THIS  POINT  IN  THIS  RUN.' 
WRITE(6, *) 

WRITE (6,*)'  FOLLOWING  ARE  THE  ENERGIES  AND  SPECIES  FOR  THIS  RUN' 
WRITE (6,*) 

DO  475  IE-1, lEMAX 

WRITE (6,*)'  ENERGY  (KEV)  =  ' , ABS (ALAM(IE) *CALVM) /lOOO . 0, 

1  '  SPECIES  NUMBER  =  ',IFLAV{IE) 

475  CONTINUE 

WRITE (6,*)'  ENTER  0  TO  STOP,  ANY  OTHER  NUMBER  TO  TRY  AGAIN' 
READ(5,*)IANSW 
IF(IANSW.EQ.0)STOP 
WRITE (6,*) 

GO  TO  300 
ENDIF 

IF( (ALAM(IFIX(BK) ) .LT.0.0) .AND. (JFLAV.NE.l) ) THEN 
WRITE (6,*) 

WRITE(6,*)'  PARTICLE  TYPE  AND  INVARIANT  ENERGY  ARE  INCORRECT.' 
WRITE{6,*)'  enter  0  STOP,  AND  OTHER  NUMBER  TO  CONTINUE.' 

READ (5,*)  lANSW 
WRITE (6,*) 

IF(IANSW.EQ.0)STOP 
GO  TO  300 
ENDIF 

INTERPOLATE  FLUX  ARRAYS  IN  SPACE,  TIME  AND  ENERGY 


FLXOUT (1) -G3NTRP (FLUX, LATDIM, LTDIM, lEMAX, BI, BJ, BK) 

FLXOUT (2 ) -G3NTRP (FLUXl , LATDIM, LTDIM, lEMAX,  BI , BJ,  BK) 

SATFLX-G3NTRP (FLXOUT, 2, 1 , 1 , TIMTRP,  1 .,  1 . ) 

WRITE (6,*)'  BI,BJ,BK, TIMTRP, FLXOUT  ', BI, BJ, BK, TIMTRP, FLXOUT 

WRITE  OUT  FLUX,  INCLUDING  ERROR  AND  THRESHOLD  IF  AVAILABLE 

ERROR-G3NTRP (ERSHFT, lEMAX, 1 , 1 , BK, 1 . , 1 . ) 

WRITE (6,*) 

WRITE(6,*)'  FLUX  AT  THE  SATELLITE  (LOG (#/CM2-S-KEV-STER) )  -  ', 

1  SATFLX 
WRITE (6,*) 

IF (ERROR . NE . 0 . 0 ) THEN 

WRITE (6,*)'  THE  ERROR  BETWEEN  THE  MODEL  OUTPUT  AND  SATELLITE  ' 
WRITE (6,*)'  DATA  IS  ', ERROR 

WRITE (6,*)'  PLEASE  NOTE  THAT  THE  ERROR  WAS  CALCULATED  USING  ' 
WRITE (6,*)'  DATA  AT  GEOSYNCHRONOUS  ORBIT  AND  IS  ONLY  VALID  FOR' 
WRITE(6,*)'  POINTS  AT  6.6  RE.' 

WRITE (6, *) 

ENDIF 

THRSHK-G3NTRP (THRSH, lEMAX, 1 , 1 , BK, 1 . , 1 . ) 

WRITE (6,*) 

IF (THRSHK . NE . 0 . 0 ) THEN 

WRITE (6,*)'  THE  PARTICLES  USED  IN  THE  FLUX  CALCULATION  WERE  ' 
WRITE (6,*)'  ABOVE  THE  THRESHOLD  LEVEL  AND  THE  FULL-TRACEBACK' 
WRITE (6,*)'  METHOD  WAS  NOT  USED.' 

ENDIF 

C  WRITE(6,*)'  ERROR,  THRSHK  ', ERROR, THRSHK 
WRITE (6,*) 

500  WRITE (6,*)  'TRACE  FROM  ANOTHER  STARTING  POINT' 

WRITE (6,*)  'WITH  SAME  TIME  PARAMETERS?  (1  =  YES)' 

READ (5,*)  KK 
IF  (KK.EQ.l)  GOTO  300 
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INPUT  FOR  SPATIAL  COORDINATE  OF  SATELLITE 


FTILT-  AUGPAR(23) 

FSTDFF-AUGPAR (24) 

FDST-AUGPAR(7) 

FEQEDG-AUGPAR(8) 

FCLP  SE-AUGPAR (15) 

20  CONTINUE 

WRITE(6,*)  'ENTER  SPATIAL  POINT  OF  INTEREST  IN  GSM  (RE):  X,Y,Z' 
READ (5,*)  XSTRT, YSTRT, ZSTRT 

CHECK  VALIDITY  OF  INPUT  PARAMETERS  AND  TRACER  START  POINT 
CALL  VALID (FTILT, FSTDFF, FDST, FEQEDG, FCLPSE, XSTRT,  YSTRT,  ZSTRT, 

1  I VALID) 

IF  (IVALID.EQ.O)  THEN 

WRITE (6,*)  'INVALID  INPUT.  TRY  AGAIN?  (0  =  YES)' 

READ(5,*)  KK 
IF  (KK.EQ.O)  GOTO  20 
STOP 
END  IF 

CALL  MAPTRK (FSTDFF, FTILT, FEQEDG, FDST, FCLPSE,  XSTRT,  YSTRT,  ZSTRT, 

1  XMAP,YMAP, ZMAP) 

IF(ABS(XMAP) .LT.l.O.AND.ABS (YMAP) . LT. 1 . 0 .AND. ABS (ZMAP) .LT.1.0) 

1  GO  TO  500 
WRITE (6,*) 

WRITE (6,*)  'INTERPOLATED  MAPPING  POINT:  XGSM  YGSM  ZGSM' 
WRITE (6,*)  XMAP, YMAP, ZMAP 
WRITE (6,*) 


CHECK  THAT  THE  MAPPED  POINT  IS  WITHIN  THE  BOUNDARY  OF  THE  MODEL 
CALCULATION 


RTEST-SQRT(XMAP**2  +  YMAP* *2  +  ZMAP* *2) 

PTEST=ATAN2 (YMAP, XMAP) 

IF (PTEST.GT. 2 . 0*PI ) PTEST=PTEST- (2 . 0*PI) 
IF(PTEST.LT.0.0)PTEST=PTEST  +  2.0*PI 
CALL  LOCATE (RTEST, PTEST, LATDIM, LTDIM, R, P, BI, BJ) 
JPLACE-IFIX(BJ) 

BNDY-G3NTRP (BNDLOC, LTDIM, 2, 1, BJ, TIMTRP, 1.0) 

1PLACE=IFIX (BNDY) 

IF(  (RdPLACE,  JPLACE)  .LT.  RTEST)  )  THEN 
WRITE (6,*) 

WRITE (6,*)'  POINT  MAPPED  TO  IS  OUT  OF  THE  BOUNDARY  OF  THE  ' 
WRITE(6,*)'  MSM  CALCULATION  REGION.  ' 

WRITE (6,*)'  BOUNDARY  LOCATION  ', R (IPLACE, JPLACE) ,' RE' 

WRITE (6,*)'  SATELLITE  MAPS  TO  ', RTEST, 'RE' 

WRITE(6, *) 

GO  TO  500 
ENDIF 

CALVM-G3NTRP (VM, LATDIM, LTDIM, 2 , BI , BJ, TIMTRP) 

ALMCHK- (ENERGY/CALVM) *1000.0 

C  WRITE (6, * ) ' ENERGY, CALVM, ALMCHK' , ENERGY, CALVM, ALMCHK 

C  WRITE(6,*)'  VM(IFIX(BI,BJ) )  ' , VM (IFIX (BI) , IFIX (BJ) , 1 ) 

C 

C  CHECK  TO  SEE  IF  THE  ENERGY  AND  SPECIES  INPUT  IS  WITHIN  OUR 
C  CALCULATED  RANGE 
C 

XLO*-1.0 

DO  550  IE-1, IEMAX-1 

IF( (IFLAV(IE) .NE. JFLAV) .AND. (IFLAV(IE+1) .NE. JFLAV) )GO  TO  550 
IF ( (ALMCHK. GE. ABS (ALAM(IE) ) ) .AND. (ALMCHK . LE . ABS (ALAM(IE+1) ) ) 
1  .AND. (IFLAV(IE) . EQ. IFLAV ( IE+1 ) ) ) THEN 

XLO-(ALMCHK-mBS(ALAM(IE) ) ) / (ABS (ALAM( IE+1) ) -ABS (ALAM (IE) ) ) 
BK-FLOAT(IE)+XLO 
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PURPOSE 


INPUT 


OUTPUT 

VARIABLES 


MAP03800 

-DETERMINE  THE  MAGNETIC  FIELD  MAPPING  CONNECTING  AN  MAP03810 
ARBITRARY  POINT  IN  SPACE  TO  THE  MSM  COMPUTATIONAL  MAP03820 

SURFACE  (THE  GSM  EQUATORIAL  PLANE  FOR  DIPOLE  TILT  ANGLEMAP03830 
SET  EQUAL  TO  ZERO)  MAPPINGS  ARE  DONE  FROM  A  GIVEN  POINTMAP03840 
TO  A  SURFACE  FOR  ALL  MODELS  IMMEDIATELY  ADJACENT  IN  MAP03850 
THE  MODELS  EXTERNAL  PARAMETER  SPACE.  (SEE  OUTLINE  OF  MAP03860 
METHOD  GIVEN  IN  MSM  QUARTERLY  REPORT  NO.  11)  MAP03870 

.NOTE:  PROCEDURE  IS  STOPPED  IF  AN  OPEN  FIELD-LINE  IS  FOUND  MAP03880 
DURING  ONE  OF  THE  TRACES  OR  IF  THERE  ARE  LESS  THAN  THE  MAP03890 
MINIMUM  NUMBER  (8)  OF  ESTABLISHED  MODELS  REQUIRED  FOR  MAP03900 
A  PROPER  INTERPOLATION. 

-FTILT:  DIPOLE  TILT  ANGLE  (DEGREES,  POSITIVE  FOR 
NORTHERN  HEMISPHERE  SUMMER. 

FSTDFF:  MAGNETOPAUSE  STAND-OFF  DISTANCE  (RE) 

FDST:  MAGNETIC  ACTIVITY  DST  (NT) 

FEQEDG:  DIPOLE  LAT.  OF  MIDNIGHT  EQUATORWARD  DIFFUSE 
AURORA  BOUNDARY  (DEG) 

FCLPSE:  MAGNETOTAIL  FIELD  COLLAPSE  INDICATOR 
XSTRT,YSTRT,ZSTRT:  STARTING  POINT  FOR  MAGNETIC  FIELD 

TRACES  (GSM  COORDINATES) 

-XMAP,YMAP, ZMAP:  INTERPOLATED  MAPPING  POSITION  (GSM) 

-XHIT,YHIT, ZHIT:  MAPPING  POINT  OF  INDIVIVUAL  TRACES 

lOPEN:  OPEN/CLOSED  FIELD-LINE  INDICATOR  1  »  OPEN 

0  =  CLOSED 

BFEXST:  INDICATES  IF  B-FIELD  MATRIX  EXISTS 
TPRM:  MAGNETIC  FIELD  MODEL  INTERNAL  INPUT  PARAMETERS 
BFLIM:  ESTABLISHED  PARAMETERS  WHICH  BRACKET  BFPAR 
T:  COEFFICIENTS  FOR  SINGLE  LINEAR  INTERPOLATION  USED 
CONSTRUCT  VALUES  OF  VARIABLE  COEFF. 

BFPAR:  THE  INPUT  PARAMETERS 
COEFF:  INTERPOLATION  COEFFICIENT 
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I SWI T , STAND , TI LT , H JNEAR, XNEAR, H JFRAC , DY , D , COLLAP , DELXC , MAP  04120 


SUBROUTINE-BFIELD : 

BMNMAP: 
GETIP : 


DYC,BRN,BRP,RN,RP:  MAGNETIC  FIELD  MODEL  INTERNAL 
INPUTS  (SEE  SUBROUTINE  BFIELD  FOR  DETAILS) 

XMAX, YMAX, ZMAX:  MAXIMUM  VALUES  OF  XHIT, YHIT, ZHIT 
XMIN, YMIN, ZMIN:  MINIMUM  VALUES  OF  XHIT, YHIT, ZHIT 
XRANGE,YRANGE, ZRANGE:  =  MAXIMUM  -  MINIMUM  OF  ABOVE 
MAGNETIC  FIELD  MODEL  POINT  CALCULATIONS 
MAPS  SINGLE  FIELD  LINE  TO  MINIMUM  |B|  SURFACE 
COLLECTS  INTERNAL  BFIELD  MODEL  INPUTS 
FROM  THE  RESPECTIVE  MATRICES  FOR  THE  GROUP 
OF  MODELS  IN  CLOSEST  PROXIMITY  OF  PARAMETER 
SPACE  TO  THE  MSM  INPUTS. 


MAP04130 

MAP04140 

MAP04150 

MAP04160 

MAP04170 

MAP04180 

MAP04190 

MAP04200 

MAP04210 

MAP04220 

MAP04230 

MAP04240 

MAP04250 

MAP04260 


NOTE:  THIS  SUBROUTINE  CONTAINS  PARTS  WHICH  WERE  ADAPTED  DIRECTLY 
FROM  SUBROUTINE  BTRACE  AS  PROGRAMMED  BY  R.W.  SPIRO.  THESE 
INCLUDE  THE  MATRIX  READING  PROCEDURE,  DEVELOPING  THE  PARAMETER  MAP04270 
WEIGHTING  COEFFICIENTS,  AND  THE  FIVE  DIMENSIONAL  INTERPOLATION  MAP04280 


SCHEME . 

REFERENCE : 

FIVE  DIMENSIONAL  INTERPOLATION  IS  BASED  ON  MULTILINEAR 
INTERPOLATION  SCHEME  GIVEN  BY  PRESS  ET  AL.  IN 
NUMERICAL  RECIPES,  CAMBRIDGE  UNIVERSITY  PRESS,  1987, PP  95-97 

LOGICAL*!  BFEXST (2, 2, 2, 2, 2) 

DIMENSION  TPRM(14,2,2,2,2,2) 

DIMENSION  XHIT  (2,  2, 2,  2, 2)  ,  YHIT  (2,  2, 2,  2,  2 )  ,  ZHIT  (2, 2, 2, 2, 2) 
DIMENSION  BFLIM (2, 5) , BFPAR (5) 

DIMENSION  T  (2,5) ,N(5) 

SET  UP  BFPAR  VECTOR  FOR  CALLING  GETMAT 
BFPAR (1)«FSTDFF 
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(1  =  YES) 


WRITE (6,*)  'AGAIN  WITH  NEW  TIME? 
READ(5,*)  KK 
IF  (KK.EQ.l)  GOTO  100 

STOP 

END 


C******************** ***********  VALID 

SUBROUTINE  VALID (TILT, STDF, DST, EQBDY, COLLAP, XSTRT, YSTRT, ZSTRT, 
1  I VALID) 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


PURPOSE-  DETERMINE  IF  EXTERIOR  MODEL  INPUTS  ARE  WITHIN  VALID 
RANGES. 

INPUT-  TILT:  DIPOLE  TILT  ANGLE  (DEG) 

STDF:  MAGNETOPAUSE  STAND-OFF  DISTANCE  (RE) 

DST:  MAGNETIC  FIELD  STRENGTH  INDEX  (NT) 

EQBDY:  MIDNIGHT  EQUATORWARD  BOUNDARY  OF  DIFFUSE 
AURORA  (DEGREES  DIPOLE  LATITUDE) 

COLLAP:  SUBSTORM  MAGNETOTAIL  FIELD  COLLAPSE  INDICATOR 
XSTRT, YSTRT, ZSTRT:  GSM  STARTING  POINT  FOR  B-FIELD  TRACE 
OUTPUT-  IVALID:  INDICATOR  OF  PARAMETER  SET  VALIDITY 
1  =  VALID,  0  =  INVALID 

VARIABLE-DIST:  GEOCENTRIC  DISTANCE  TO  TRACER  STARTING  POINT  (RE) 

SET  MAXIMUM (MX)  AND  MINIMUM (MN)  ACCEPTABLE  PARAMETER  VALUES 
DATA  TILTMX,TILTMN/35.00,-35.00/ 

DATA  STDFMX,STDFMN/14.00,6.00/ 

DATA  DSTMX,DSTMN/50.00,-400.00/ 

DATA  EQBDYMX,EQBDYMN/69.30,49.47/ 

DATA  COLLAPMX,COLLAPMN/1.00,0.00/ 

IVALID  -  1 

IF  ( (TILT. LT.TILTMN) .OR. (TILT. GT.TILTMX) )  THEN 
IVALID  *=  0 

WRITE (6,*)  'TILT  VALUE' , TILT, 'IS  OUT  OF  RANGE' 

END  IF 

IF  ( (STDF. LT.STDFMN) .OR. (STDF. GT.STDFMX) )  THEN 
IVALID  =  0 

WRITE (6,*)  'STAND-OFF  VALUE' , STDF, ' IS  OUT  OF  RANGE' 

END  IF 

IF  ( (DST.LT.DSTMN) .OR. (DST.GT.DSTMX) )  THEN 
IVALID  -  0 

WRITE (6,*)  'DST  VALUE' , DST, ' IS  OUT  OF  RANGE' 

END  IF 

IF  ( ( EQBDY . LT . EQBDYMN ) . OR . ( EQBDY . GT . EQBDYMX ) )  THEN 
IVALID  =  0 

WRITE (6,*)  'EQEDGE  VALUE' , EQBDY, ' IS  OUT  OF  RANGE' 

END  IF 

IF  ( ( COLLAP . LT . COLLAPMN ) . OR . ( COLLAP . GT . COLLAPMX ) )  THEN 
IVALID  -  0 

WRITE (6,*)  'COLLAPSE  VALUE' , COLLAP, ' IS  OUT  OF  RANGE' 

END  IF 

DIST  -  SQRT(XSTRT**2  +  YSTRT**2  +  ZSTRT**2) 

IF  (DIST.LE.l.)  THEN 
IVALID  =  0 

WRITE(6,*)  'INVALID  STARTING  POINT  FOR  FIELD-LINE  TRACE  (<1  RE)' 
END  IF 


RETURN 

END 

C**************************  MAPTRK 

SUBROUTINE  MAPTRK (FSTDFF, FTILT, FEQEDG, FDST, FCLPSE, 

1  XSTRT, YSTRT, ZSTRT, XMAP,YMAP, ZMAP) 
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BFPAR(2)«FTILT 

BFPAR(3)-FEQEDG 

BFPAR(4)»FDST 

BFPAR(5)-FCLPSE 


INITIALIZE  "HIT"  ARRAYS  AND  MAPPING  RESULT 
X  -  1. 

Y  -  1. 

Z  -  1. 

XMAP  -  0. 

YMAP  -  0. 

ZMAP  -  0, 

DO  15  1-1,2 
DO  16  J-1,2 
DO  17  K=l,2 
DO  18  L=l,2 
DO  19  M=l,2 

XHITd,  J,K,L,M)  =  0. 

YHITd,  J,K,L,M)  =  0. 

ZHITd,  J,K,L,M)  =  0. 

19  CONTINUE 

18  CONTINUE 

17  CONTINUE 

16  CONTINUE 
15  CONTINUE 

GET  INTERNAL  B-FIELD  PARAMETERS 

CALL  GETIP (BFPAR, TPRM, BFLIM, BFEXST) 

SET  UP  WEIGHTING  PARAMETERS  FOR  INTERPOLATION 


DO  10  11=1,5 

T <2, II) = (BFPAR (11) -BFLIM (1, II) ) / (BFLIM (2, II ) -BFLIM (1 , II ) ) 
T(1,II)-1.-T(2,II) 

CONTINUE 


FIND  MINUMUM  CROSSING  POINT  FOR  EACH  OF  THE  "CORNERS" 
DO  31  I  -  1,2 
DO  32  J  -  1,2 
DO  33  K  -  1,2 
DO  34  L  =  1,2 
DO  35  M  =  1,2 

IF  (. NOT, BFEXST (I, J,K,L,M) )  THEN 

DO  NOT  ATTEMPT  A  FIELD-LINE  TRACE 
GOTO  36 
END  IF 

SET  INTERNAL  PARAMETERS 
STAND  -  TPRM(  1,I,J,K,L,M) 

TILT  -  TPRM(  2,I,J,K,L,M) 

HJNEAR  -  TPRM(  3,I,J,K,L,M) 

XNEAR  =  TPRM(  4,I,J,K,L,M) 

HJFRAC  -  TPRM(  5,I,J,K,L,M) 

DY  -  TPRM(  6,I,J,K,L,M) 

D  =  TPRM(  7,I,J,K,L,M) 

COLLAP  =  TPRM(  8,I,J,K,L,M) 

DELXC  -  TPRM(  9,I,J,K,L,M) 

DYC  =  TPRM(10,I, J,K,L,M) 

BRN  ”  TPRM(11,I, J,K,L,M) 

BRP  -  TPRM(12,I, J,K,L,M) 

RN  -  TPRM(13,I,  J,K,L,M) 

RP  =  TPRM(14, I, J,K,L,M) 


SET-UP  BFIELD  INTERNAL  COEFFICIENTS  AND  TAIL  CURRENTS 
ISWIT  -  0 
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mapintfor 

CALL  BFIELD (ISWIT, X, Y, Z, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 

1  COLLAP, DELXC, DYC, BRN, BRP, RN, RP, RADIUS, BX, BY, BZ) 

CALL  BFIELD (ISWIT, X, Y, Z, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 

1  COLLAP, DELXC, DYC, BRN, BRP, RN, RP, RADIUS, BX, BY, BZ) 

SINGLE  MAGNETIC  FIELD-LINE  TRACE  TO  MININIMUM  |B|  SURFACE 
CALL  BMNMAP (ISWIT, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY,D, COLLAP, 

1  DELXC, DYC, BRN, BRP, RN,RP, RADIUS, XSTRT,YSTRT,ZSTRT, 

2  IOPEN,XHIT(I, J,K,L,M) , YHIT (I, J, K, L,M) , ZHIT (I, J, K, L,M) ) 

IF  (lOPEN.EQ.l)  THEN 

WRITE (6,*)  'OPEN  FIELD-LINE  FOUND,  INTERPOLATION  INVALIDATED' 
WRITE (6,*)  'EXITED  FROM  SUBROUTINE  MAPTRACE' 

RETURN 
END  IF 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

INITIALIZE  RANGE  SPREAD  INDICATORS 
XMAX  -  -999. 

YMAX  =  -999. 

ZMAX  =  -999. 

XMIN  -  999. 

YMIN  -  999. 

ZMIN  =  999. 

MAIN  INTERPOLATION  LOOPS 
DO  21  Nl-1,2 
N(1)=N1 
DO  22  N2-l,2 
N(2)=n2 
DO  23  N3=l,2 
N(3)=N3 
DO  24  N4=l,2 
N(4)=N4 
DO  25  N5=l,2 
N(5)=N5 

COEFF=l . 

DO  30  M=l,5 

COEFF=COEFF*T (N (M) , M) 

CONTINUE 

XMAP  =  XMAP  +  C0EFF*XHIT(N1,N2,N3,N4,N5) 

YMAP  =  YMAP  +  C0EFF*YHIT(N1,N2,N3,N4,N5) 

ZMAP  =  ZMAP  +  C0EFF*ZHIT(N1,N2,N3,N4,N5) 

UPDATE  MAX-MIN  RANGES 
IF  (BFEXST(N1,N2,N3,N4,N5) )  THEN 

IF  (XHIT(N1,N2,N3,N4,N5) .GT.XMAX)  THEN 
XMAX  =  XHIT(N1,N2,N3,N4,N5) 

ELSE 

IF  (XHIT(N1,N2,N3,N4,N5) .LT.XMIN)  THEN 
XMIN  =  XHIT(N1,N2,N3,N4,N5) 

END  IF 
END  IF 

IF  ( YHIT (Nl, N2, N3, N4, N5) .GT. YMAX)  THEN 
YMAX  =  YHIT(N1,N2,N3,N4,N5) 

ELSE 

IF  (YHIT (N1,N2,N3,N4,N5) .LT. YMIN)  THEN 
YMIN  =  YHIT(N1,N2,N3,N4,N5) 
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MAP05330 

MAP0534P 

MAP05350 

MAP05360 

MAP05370 

MAP05380 

MAP05390 

MAP05400 

MAP05410 

MAP05420 

MAP05430 

MAP05440 

MAP05450 

MAP05460 

MAP05470 

MAP05480 

MAP05490 

MAP05500 

MAP05510 

MAP05520 

MAP05530 

MAP05540 

MAP05550 

MAP05560 

MAP05570 

MAP05580 

MAP05590 

MAP05600 

MAP05610 

MAP05620 

MAP05630 

MAP05640 

MAP05650 

MAP05660 

MAP05670 

MAP05680 

MAP05690 

MAP05700 

MAP05710 


mapint-for 


END  IF 
END  IF 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 


IF  {ZHIT(N1,N2,N3,N4,N5) .GT.ZMAX)  THEN 
ZMAX  =  ZHIT(N1,N2,N3,N4,N5) 

ELSE 

IF  (ZHIT(N1,N2,N3,N4,N5) .LT.ZMIN)  THEN 
ZMIN  =  2HIT(N1,N2,N3,N4,N5) 

END  IF 
END  IF 
END  IF 

25  CONTINUE 

24  CONTINUE 

23  CONTINUE 

22  CONTINUE 

21  CONTINUE 

XRANGE  -  XMAX  -  XMIN 
YRANGE  -  YMAX  -  YMIN 
ZRANGE  -  ZMAX  -  ZMIN 

WRITE (6,*)  'MAPPING  POINTS  USED  FOR  INTERPOLATION  WERE  SPREAD:' 
WRITE (6,*)  XRANGE, 'RE  ALONG  THE  XGSM  DIRECTION' 

WRITE (6,*)  YRANGE, 'RE  ALONG  THE  YGSM  DIRECTION' 

WRITE{6,*)  ZRANGE, 'RE  ALONG  THE  ZGSM  DIRECTION' 

RETURN 

END 

******************************  getip  ****************************** 

SUBROUTINE  GETIP (BFPAR, TPRM, BFLIM, BFEXST) 

PURPOSE-  FIND  THE  MSM  PARAMETER  SETS  WHICH  LIE  CLOSEST  TO  THE 
INPUT  PARAMETER  SET  AND  LOAD  THE  B-FIELD  MODEL 
INTERNAL  PARAMETERS  FROM  THE  APPROPRIATE  MATRICES  TO 
BE  PASSED  ON  FOR  MAGNETIC  FIELD  LINE  TRACING  PURPOSES 
BFPAR:  MSM  INPUTS 

TPRM:  BFIELD  MODEL  INTERNAL  INPUTS  (14  FOR  EACH) 
BFLIM:  VALUES  FROM  PARAMETER  "GRID"  WHICH  BRACKET 

THE  VALUES  OF  BFPAR 

BFEXST:  INDICATES  IF  A  BFIELD  MODEL  AS  REPRESENTED 
BY  A  MATRIX  HAS  BEEN  LOADED. 

BFNDX:  INDEX  ASSIGNED  TO  BFLIM  VALUES 

STNDPR, TILTPR,FINEDP,DSTPR, STCHPR:  GRID  VALUES  OF  THE 
MSM  INPUTS 

MSTND,MTILT, MINED, MDST,MSTCH:  NUMBER  OF  GRID  POINTS 
FOR  EACH  MSM  INPUT 

ICOUNT:  NUMBER  OF  PARAMETER  SETS  LOADED. 
SUBROUTINES-FNDBRK:  FINDS  THE  SET  OF  B-FIELD  MODELS  WHICH 

BRACKET  THE  POINT  OF  INTEREST  IN  PARAMETER 
SPACE . 

LOADIP:  LOADS  INTERNAL  B-FIELD  PARAMETERS  FROM  MATRIX 
FILES  INTO  VARIABLE  TPRM. 

FUNCTIONS-MEXIST:  INDICATES  IF  A  BFIELD  MODEL  EXISTS 

PARAMETER  (IMSTND=5, IMTILT=5, IMINED=16, IMDST=8, IMSTCH=2) 

LOGICAL  MEXIST 
INTEGER  BFNDX (2, 5) 

LOGICAL*!  BFEXST (2, 2, 2, 2, 2) 

DIMENSION  STNDPR (IMSTND) , TILTPR (IMTILT) , FINEDP (IMINED) 

DIMENSION  DSTPR(IMDST) ,STCHPR(IMSTCH) 

DIMENSION  BFLIM (2, 5) , BFPAR (5) 

DIMENSION  TPRM(14,2,2,2,2,2) 

DATA  MSTND/ IMSTND/ 

DATA  MTILT/IMTILT/ 


INPUT- 

OUTPUT- 


VARIABLES- 


MAP05720 

MAP05730 

MAP05740 

MAP05750 

MAP05760 

MAP05770 

MAP05780 

MAP05790 

MAP05800 

MAP05810 

MAP05820 

MAP05830 

MAP05840 

MAP05850 

MAP05860 

MAP05870 

MAP05880 

MAP05890 

MAP05900 

MAP05910 

MAP05920 

MAP05930 

MAP05940 

MAP05950 

MAP05960 

MAP05970 

MAP05980 

MAP05990 

MAP06000 

MAP06010 

MAP06020 

MAP06030 

MAP06040 

MAP06050 

MAP06060 

MAP06070 

MAP06080 

MAP06090 

MAP06100 

MAP06120 

MAP06130 

MAP06140 

MAP06150 

MAP06160 

MAP06170 

MAP06200 

MAP06210 

MAP06220 

MAP06230 

MAP06240 

MAP06110 

MAP06250 

MAP06260 

MAP06270 

MAP06290 

MAP06300 

MAP06310 

MAP06320 

MAP06330 

MAP06340 

MAP06350 

MAP06360 

MAP06370 


mapmt.for 


DATA 

DATA 

DATA 

DATA 

DATA 

DATA 


MINED/ IMINED/ 

MDST/IMDST/ 

MSTCH/IMSTCH/ 

STNDPR/6. 0,8. 0,10. 0,12. 0,14.0/ 
TILTPR/-35.0,-17.5,0.0,17.5,35.0/ 
FINEDP/49.47,  53.20,  55.89,  57.96, 
62.06,  63.02,  63.99, 
66.72,  67.45,  68.12, 


1  60.95, 

2  65.91, 

3  69.30/ 
DATA  DSTPR/-400.0, 

1  -100.0, 


59.60, 

65.01, 

68.73, 


-300.0,  -200.0,  -150.0, 
-50.0,  0.0,  50.0/ 


DATA  3TCHPR/0.0,  1.0/ 

EXTERNAL  MEXIST 

CALL  FNDBRK(BFPAR(1) , STNDPR,MSTND,BFNDX(1, 1) ,BFNDX(2,1) ) 
CALL  FNDBRK{BFPAR(2) , TILTPR, MTILT, BFNDX (1, 2) ,BFNDX(2,2) ) 
CALL  FNDBRK ( BFPAR ( 3 ) , FINEDP , MINED, BFNDX (1,3),  BFNDX (2,3)) 
CALL  FNDBRK(BFPAR(4) ,DSTPR,  MDST,  BFNDX (1, 4) , BFNDX (2, 4) ) 
CALL  FNDBRK(BFPAR(5) ,STCHPR,MSTCH,BFNDX(1,5) ,BFNDX(2,5) ) 


DO  5,  1-1,2 
BFLIM{I,1) 
BFLIM(I,2) 
BFLIMd,  3) 
BFLIM(I,4) 
BFLIMd,  5) 
CONTINUE 


STNDPR (BFNDX (I , 1 ) ) 
TILTPR (BFNDX (1,2) ) 
FINEDP (BFNDX (1,3)) 
DSTPR(BFNDX(I,4) ) 
STCHPR (BFNDX (I, 5) ) 


50 

40 

30 

20 

10 


1000 


C 

C 

C 

C 


ICOUNT  -  0 
DO  10,  1=1,2 
DO  20,  J-1,2 
DO  30,  K=l,2 
DO  40,  L-1,2 
DO  50,  M-1,2 

IF  (MEXI ST ( BFNDX (1,1), BFNDX (J, 2) , BFNDX (K, 3) , 

L  BFNDX(L, 4),BFNDX(M, 5) ) )  THEN 

CALL  LOADIPd,  J,K,L,M,  BFNDX,  TPRM) 

BFEXSTd,  J,K,  L,M)  =  .TRUE. 

ICOUNT  =  ICOUNT  +  1 
ELSE 

BFEXSTd,  J,K,L,M)  =  .F'LSE. 

ENDIF 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

IF  (ICOUNT.lt. 8)  THEN 
WRITE (6, 1000)  ICOUNT 

FORMAT (IX, 'ONLY' , 13, '  MODELS  AVAILABLE  (NEED  8  MINIMUM) ' ) 

WRITE (6,*)  'B-FIELD  TRACING  INTERPOLATION  PROCEDURE  INVALIDATED 
WRITE (6,*)  'EXITED  FROM  SUBROUTINE  GETIP' 

RETURN 
END  IF 


RETURN 

END 

****************************** 


LOAD IP 

SUBROUTINE  LOADIP (I , J, K, L, M, BFNDX, TPRM) 
PURPOSE- 


MAP06380 

MAP06390 

MAP06400 

MAP06410 

MAP06420 

MAP06430 

MAP06440 

MAP06450 

MAP06460 

MAP06470 

MAP06480 

MAP06490 

MAP06500 


MAP06510 

MAP06540 

MAP06550 

MAP06560 

MAP06570 

MAP06580 

MAP06590 

MAP06600 

MAP06610 

MAP06620 

MAP06630 

MAP06640 

MAP06650 

MAP06660 

MAP06670 

MAP06680 

MAP06690 

MAP06700 

MAP06710 

MAP06720 

MAP06730 

MAP06740 

MAP06750 

MAP06760 

MAP06770 

MAP06780 

MAP06790 

MAP06800 

MAP06810 

MAP06820 

MAP06830 

MAP06840 

MAP06850 

MAP06860 

MAP06870 

MAP06880 

MAP06890 

MAP06900 

MAP06910 

MAP06920 

MAP06930 

MAP06940 

MAP06950 

MAP06960 

MAP06970 

*MAP06980 

MAP06990 

MAP07000 

MAP07010 


SSI 


mapint.for 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


THIS  SUBROUTINE  LOADS  INTERNAL  MODEL  PARAMETERS  FROM  OFFLINE 
B-SUPERMATRIX  INTO  THE  TPRM  MATRIX.  A  CHECK  IS  MADE  TO 
VERIFY  THAT  THE  CORRECT  PARAMETERS  HAVE  BEEN  RETRIEVED.  IF  THIS 
CHECK  FAILS  THE  PROGRAM  WILL  STOP.  THIS  SUBROUTINE  HAS  THE  SAME 
BASIC  STRUCTURE  (AND  READS  FROM  THE  SAME  DATA  FILES)  AS 
LOADBM.  ONE  CALL  PER  MODEL. 

INPUT- 


MAP07020 
MAP07030 
MAP07040 
MAP07050 
SUBROUTINE  MAP07060 
MAP07070 


I,J,K, L,M:  INDICES  FOR  MATRIX  BFNDX 

BFNDX:  INDEX  NUMBERS  OF  PARAMETERS  USED  TO  IDENTIFY 
INDIVIDUAL  MATRICES. 

TPRM:  INTERNAL  B-FIELD  PARAMETERS  (14)  FOR  MAXIMUM  OF 
DIFFERENT  MODELS  (2X2X2X2X2) 
VARIABLES-IDF1-IDF6:  MATRIX  IDENTIFIERS 


OUTPUT- 


INTEGER  BFNDX (2, 5) 

CHARACTER* 32  FILNAM 

DIMENSION  TPRM(14,2,2,2,2,2) 

WRITE  (FILNAM,1000)  BFNDX(J,2),  BFNDX{I,1),  BFNDX(L,4), 
L  BFNDX(K, 3), (3-BFNDX(M, 5) ) 

FORMAT  ('BFIELD:BO' ,11/11/11/12.2,11,' .DAT' ) 


OPEN 


READ 


(UNIT=99, FILE=FILNAM, ERR=199, FORM=' FORMATTED' , 
ACCESS”' SEQUENTIAL' ) 


800 


MAP07080 
MAP07090 
MAP07100 
32  MAP07110 

MAP07120 
MAP07130 
MAP07140 
MAP07150 
MAP07160 
MAP07170 
MAP07180 
MAP07190 
MAP07200 
MAP07210 

1000  FORMAT  ('BFIELD:BO' ,11,11,11,12.2,11,' .DAT' )  MAP07220 

:  MAP07230 

MAP07240 
MAP07250 
MAP07260 

(99,800)  IDF1,IDF2,IDF3,IDF4,IDF5,IDF6,TPRM(  1, I, J, K, L,M) ,MAP07270 
TPRM(  2,I,J,K,L,M),TPRM(  3, I, J, K, L,M) , TPRM (  4, I , J, K, L,M) ,MAP07280 
TPRM(  5, I, J,K,L,M) ,TPRM(  6, I, J, K, L, M) , TPRM (  7, I, J, K, L,M) ,MAP07290 
TPRM(  8,1, J,K,L,M) ,TPRM(  9, I, J, K, L, M) , TPRM (10, I , J, K, L,M) ,MAP07300 
TPRM(11,I, J,K,L,M) , TPRM (12,1, J,K,L,M) , TPRM  (13,1, J,K,L,M) ,MAP07310 
TPRM(14,I, J,K,L,M)  MAP07320 

FORMAT (311, 12. 2, II, 13, 14F8. 2)  MAP07330 

MAP07340 
MAP07350 
MAP07360 
MAP07370 
MAP07380 
MAP07390 
MAP07400 
MAP07410 
MAP07420 
MAP07430 
MAP07440 
MAP07450 
MAP07460 
MAP07470 
MAP07480 
MAP07490 
MAP07500 

1  COLLAR, DELXC,DYC,BRN,BRP,RN,RP, RADIUS, X, Y, Z,  MAP07510 

2  IOPEN,XHIT,YHIT,ZHIT)  MAP07520 

MAP07530 

PURPOSE-  MAGNETIC  FIELD  LINE  MAPPING  TO  THE  MINIMUM  |B|  SURF ACEMAP07 540 
OR  THE  MAGNETOPAUSE  BOUNDARY,  OPEN/CLOSED  DETERMINED  MAP07550 
INPUT-  FIRST  15:  BFIELD  INPUT  MAP07560 

RADIUS:  MAGNETOTAIL  RADIUS  FOR  DEFINING  BOUNDARY  MAP07570 

X,Y,Z,:  GSM  STARTING  POINT  OF  TRACE  MAP07580 

OUTPUT-  lOPEN:  DESIGNATES  OPEN  FIELD  LINE  =  1  MAP07590 

CLOSED  FIELD  LINE  -  0  MAP07600 

XHIT,YHIT,ZHIT:  LAST  TRACE  POINT.  EITHER  AT  MSM  MAP07610 

SURFACE  WHEN  FIELD  LINE  IS  CLOSED  OR  AT  A  POINT  MAP07620 
ON  THE  DEFINED  MAGNETOPAUSE  FOR  OPEN  LINES.  MAP07630 

VARIABLE-  ER,EP,H: ERROR, DIRECTION,  AND  INITIAL  TRACE  STEP  SIZE  MAP07640 

DX1,DY1,DZ1,BB:  VECTOR  INFORMATION  FOR  SUBROUT.  TRAC  MAP07650 


IF  ( (BFNDX(I,1) .NE.IDF2) .OR. (BFNDX(J,2) .NE.IDFl) .OR. 
(BFNDX (K, 3)  .NE.IDF4)  .OR. (BFNDX (L,  4) .NE.1DF3) .OR. 
( (3-BFNDX(M,5) ) .NE.IDF5) .OR. (IDF6.NE.201) )  THEN 
WRITE  (6,*)  'FILE  ', FILNAM, '  IS  INCORRECT.' 

STOP  'INCORRECT  B-FIELD.  STOPPING  IN  LOADIP.' 
ENDIF 

CLOSE  (99) 

RETURN 


199 


CONTINUE 

WRITE(6,*)  'STOPPING  IN  LOADIP.  OPEN  FAILED  ON  ', FILNAM 
STOP  'STOPPING  IN  LOADBM.  OPEN  FAILED  ON  B-MATRIX.' 

END 

c*******************************  bmnmap 

SUBROUTINE  BMNMAP (ISWIT, STAND, TILT, HJNEAR, XNEAR, HJFRAC,DY,D, 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


mapint.for 


BDIST:  =  RADIUS  -  STAND-OFF  DISTANCE 
DIST:  DISTANCE  FROM  X-AXIS 

XP:  »  XN  +  BDIST  (DISTANCE  FROM  CYLINDER-SPHERE 
INTERFACE  IN  X  DIRECTION) 

DDAY:  DISTANCE  FROM  CYLINDER-SPHERE  INTERFACE  POINT 
WHERE  YGSM  =  ZGSM  =  0 
XA,YA,ZA:  STARTING  POINT  FOR  TRACING  STEP 
XN,YN, ZN:  FINISH  POINT  FOR  TRACING  STEP 
BMAGA,BMAGN:  MAGNETIC  FIELD  MAGNITUDE  AT  POINTS 

(XA,YA,ZA)  AND  (XN,YN, ZN)  RESPECTIVELY. 

USED  WHEN  TRACE  DIRECTION  IS  BEING  DECIDED. 
BX,BY,BZ:  MAGNETIC  FIELD  STRENGTH  (NT)  DURING  TRACE. 
BSIZE:  MAGNETIC  FIELD  MAGNITUDE 
BMIN:  CURRENT  SMALLEST  B-FIELD  MAGNITUDE 
SUBROUTINE-  TRAC:  FINDS  SEQUENTIAL  STEPS  IN  VECTOR  TRACE 

BFIELD:  MAGNETIC  FIELD  MODEL  POINT  CALCULATIONS 

COMMON/BSTEP/DXl , DYl , DZl , BB, H, EP  ,  ER 

SET  TRACING  ERROR  LIMITS, INITIAL  STEP  SIZE,  AND  DIRECTION 
ER  =  0.25E-02 

H  -  0.25 

EP  =  -1.0 

INITIALIZE  QUANTITIES 
lOPEN  »  1 
XHIT  -  999. 

YHIT  -  999. 

ZHIT  -  999. 

XA  -  X 
YA  -  Y 
ZA  -  Z 
DXl-0. 

DYl-0. 

DZl-0. 

BDIST  -  RADIUS  -  STAND 

SET  BMIN  START  VALUE,  ASSUME  START  POINT  |B|  VALUE 
CALL  BFIELD (ISWIT, XA, YA, ZA, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 

1  COLLAP , DELXC , DYC, BRN, BRP , RN, RP , RADIUS , BX, BY, BZ ) 

BMIN  -  SQRT(BX**2  +  BY**2  +  BZ**2) 

CHECK  THAT  DIRECTION  OF  TRACE  IS  TOWARDS  MINIMUM 
CALL  TRAC (ISWIT, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, COLLAP, 

1  DELXC,  DYC,  BRN, BRP, RN, RP, RADIUS, XA, YA, ZA, XN, YN, ZN) 

GET  FIELD  STRENGTH  AT  STARTING  POINT 
CALL  BFIELD (ISWIT, XA, YA, ZA, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 

1  COLLAP , DELXC, DYC, BRN, BRP, RN, RP, RADIUS , BXA, BYA, BZA) 

GET  FIELD  STRENGTH  AT  FIRST  TRACER  STEP  POINT 
CALL  BFIELD (ISWIT, XN, YN, ZN, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 

1  COLLAP , DELXC , DYC , BRN , BRP , RN, RP , RADIUS , BXN , BYN , BZN ) 

BMAGA  ■  SQRT(BXA**2  +  BYA**2  +  BZA**2) 

BMAGN  -  SQRT(BXN**2  +  BYN* *2  +  BZN**2) 

IF  ( BMAGN. GT. BMAGA)  THEN 

MOVING  AWAY  FROM  MINIMUM,  CHANGE  DIRECTION 
EP  -  -EP 

CU^LL  TRAC ( I SWI T , STAND , T I LT , HJNEAR, XNEAR, HJFRAC , DY , D , COLLAP , 

1  DELXC, DYC, BRN, BRP, RN, RP, RADIUS, XA, YA, ZA, XN, YN, ZN) 

GET  FIELD  STRENGTH  AT  FIRST  TRACER  STEP  POINT  IN  NEW  DIR. 
CALL  BFIELD (ISWIT, XN, YN, ZN, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 
1  COLLAP, DELXC, DYC, BRN, BRP, RN, RP, RADIUS, BXN, BYN, BZN) 

BMAGN  -  SQRT(BXN**2  +  BYN**2  +  BZN**2) 

IF  ( BMAGN. GT. BMAGA)  THEN 

FIRST  POINT  IN  EITHER  DIRECTION  HAS  STRONGER  FIELD 
MUST  HAVE  STARTED  ON  THE  MINIMUM  |B|  SURFACE 
I OPEN  -  0 
XHIT  -  XA 


MAP07660 

MAP07670 

MAP07680 

MAP07690 

MAP07700 

MAP07710 

MAP07720 

MAP07730 

MAP07740 

MAP07750 

MAP07760 

MAP07770 

MAP07780 

MAP07790 

MAP07800 

MAP07810 

MAP07820 

MAP07830 

MAP07840 

MAP07850 

MAP07860 

MAP07870 

MAP07880 

MAP07890 

MAP07900 

MAP07910 

MAP07920 

MAP07930 

MAP07940 

MAP07950 

MAP07960 

MAP07970 

MAP07980 

MAP07990 

MAP08000 

MAP08010 

MAP08020 

MAP08030 

MAP08040 

MAP08050 

MAP08060 

MAP08070 

MAP08080 

MAP08090 

MAP08100 

MAP08110 

MAP08120 

MAP08130 

NAP08140 

MAP08150 

MAP08160 

MAP08170 

MAP08180 

MAP08190 

MAP08200 

MAP08210 

MAP08220 

MAP08230 

MAP08240 

MAP08250 

MAP08260 

MAP08270 

MAP08280 

MAP08290 


I 

0 

0 


mapmt.for 


YHIT  *•  YA 
ZHIT  -  ZA 
GOTO  20 
END  IF 
END  IF 
CONTINUE 

START  FULL  TRACE  OF  A  SINGLE  FIELD-LINE 
CALL  TRAC (ISWIT, STAND, TILT, H JNEAR, XNEAR, HJFRAC, DY, D, COLLAR, 

1  DELXC, DYC, BRN, BRP, RN, RP, RADIUS, XA, YA, ZA, XN, YN, ZN) 

DIST  -  SQRT(YN**2  +  ZN**2) 

XP  -  XN  +  BDIST 

DDAY  -  SQRT(XP**2  +  YN**2  +  ZN**2) 

IF  ( (XN.LT. (-50. ) ) .OR. (DIST. GT. RADIUS) .OR. 

1  ( (XP.GE.O.) .AND. (DDAY. GT. RADIUS) ) )  THEN 

TRACE  HIT  MAGNETOPAUSE  OR  FAR  TAIL  LIMIT  (OPEN  FIELD  LINE) 

I OPEN  -  1 
XHIT  -  XN 
YHIT  -  YN 
ZHIT  -  ZN 

WRITE (6, *)  ' **i'***** *****************************************' 
WRITE (6,*)  'OPEN  FIELD-LINE  HIT  AT  POINT:  XGSM  YGSM  ZGSM' 
WRITE (6,*)  XHIT, YHIT, ZHIT 
GOTO  20 
END  IF 

CALL  BFIELD (ISWIT, XN, YN, ZN, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 

1  COLLAR, DELXC, DYC, BRN, BRP, RN, RP, RADIUS, BX, BY, BZ) 

BSIZE  -  SQRT(BX**2  +  BY**2  +  BZ**2) 

IF  (BSIZE. LE.BMIN)  THEM 

CLOSER  TO  MINIMUM  IN  |B| 

BMIN  -  BSIZE 
XHIT  -  XN 
YHIT  -  YN 
ZHIT  «  ZN 
lOPEN  -  0 
ELSE 

PAST  MINIMUM  |B|,  DONE 
GOTO  20 
END  IF 

XA  -  XN 
YA  -  YN 
ZA  -  ZN 
GOTO  30 

CONTINUE 

RETURN 

END 

r***********************  TRAC 

SUBROUTINE  TRAC (ISWIT, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, COLLAR, 
1  DELXC, DYC, BRN, BRP, RN, RP, RADIUS , XA, YA, ZA, XN, YN, ZN) 

PURPOSE-  FINDS  SUCCESSIVE  STEP  LOCATION  IN  A  TRACE  OF  A  VECTOR 
FIELD,  E.G.,  USED  TO  MAP  MAGNETIC  FIELD  LINES. 

INPUT-  FIRST  15  ARE  BFIELD  MODEL  INPUTS  (SUBROUTINE  BFIELD) 

XA,YA,ZA:  GSM  LOCATION  OF  START  POINT  OF  VECTOR  TRACE 
OUTPUT-  RADIUS:  MAGNETOTAIL  RADIUS  (RE) 

XN,YN,ZN:  GSM  LOCATION  OF  NEXT  STEP  IN  VECTOR  TRACE. 
VARIABLES-  H:  STEP  SIZE 

EP:  DIRECTION  OF  TRACE  (+1.  IS  PARALLEL  TO  FIELD 
VECTOR  AND  -1.  IS  ANTIPARALLEL  TO  SAME) 

ER:  ALLOWABLE  DISTANCE  ERROR  LIMIT  (RE) 
SUBROUTINES-FUNC:  PROVIDES  VECTOR  INFORMATION  ABOUT  THE  BFIELD 


INPUT- 


OUTPUT- 


VARIABLES- 


MAP08300 

MAP08310 

MAP08320 

MAP08330 

MAP08340 

MAP08350 

MAP08360 

MAP08370 

MAP08380 

MAP08390 

MAP08400 

MAP08410 

MAP08420 

MAP08430 

MAP08440 

MAP08450 

MAP08460 

MAP08470 

MAP08480 

MAP08490 

MAP08500 

MAP08510 

MAP08520 

MAP08530 

MAP08540 

MAP08550 

MAP08560 

MAP08570 

MAP08580 

MAP08590 

MAP08600 

MAP08610 

MAP08620 

MAP08630 

MAP08640 

MAP08650 

MAP08660 

MAP08670 

MAP08680 

MAP08690 

MAP08700 

MAP08710 

MAP08720 

MAP08730 

MAP08740 

MAP08750 

MAP08760 

MAP08770 

MAP08780 

MAP08790 

MAP08800 

MAP08810 

MAP08820 

MAP08830 

MAP08840 

.MAP08850 

MAP08860 

MAP08870 

MAP08880 

MAP08890 

MAP08900 

MAP08910 

MAP08920 

MAP08930 


mapint.for 

COMMON/BSTEP /DXl , DYl , DZl , BB, H, EP , ER 

REAL  DXl,Dyi,DZl,BB,H,EP,ER,XA,YA,ZA,XN,YN, ZN 

CALL  FUNC (ISWIT, XA, YA, ZA, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 

1  COLLAR , DELXC, DYC, BRN, BRP , RN, RP , RADIUS , DXl , DYl , DZl , BFl 

CONTINUE 
H1-H*EP 
H2-0.5*H1 

XN1-XA+H1*DX1 

YN1-YA+H1*DY1 

ZN1-ZA+H1*DZ1 

XN2-XA+H2*DX1 

YN2-YA+H2*DY1 

ZN2=ZA+H2*DZ1 

CALL  FUNC ( I SWIT , XN2 , YN2 , ZN2 , STAND , TI LT , HJNEAR, XNEAR, HJFRAC , DY , D 
1  COLLAR , DELXC, DYC, BRN, BRP, RN, RP, RADIUS , DX2 , DY2 , DZ2 , BF2 

XN3=XN2+H2*DX2 
YN3-YN2+H2*DY2 
ZN3=ZN2+H2*DZ2 

DELX=XN1-XN3 

DELY-YN1-YN3 

DELZ«ZN1-ZN3 

RTES1-DELX*DELX 

RTES2-DELY*DELY 

RTES3-DELZ*DELZ 

RTES=SQRT (RTES1+RTES2+RTES3) 

IF(RTES-ER)  4,4,2 
CONTINUE 

XN-XN3-DELX 

YN=YN3-DELY 

ZN-ZN3-DELZ 

BB-BF2 

IF(RTES-(0.25*ER)  )  7,6,6 
H“2.*H 

***LIMIT  MAXIMUM  STEP  SIZE*** 

IF  {H.GT.<5.0))  then 
H  -  5.0 
END  IF 
GOTO  5 

CONTINUE 
H=0.5*H 
GOTO  1 

CONTINUE 

RETURN 

END 

t************************  FUNC 

SUBROUT I NE  FUNC (ISWIT, X,Y,Z,S TAND , TI LT , HJNEAR , XNEAR, HJFRAC , DY , D , 
1  COLLAP, DELXC, DYC, BRN, BRP, RN, RP, RADIUS, DX, DYY, DZ, 

PURPOSE-  PROVIDE  VECTOR  INFORMATION  ABOUT  A  FUNCTION  (BFIELD) 
INPUT-  FIRST  18:  BFIELD  INPUTS 

OUTPUT-  DX,DYY,DZ,B:  VECTOR  COMPONENT  INFORMATION 

SUBROUTINE-BFIELD:  MAGNETIC  FIELD  MODEL 

BX  -  0. 

BY  -  0. 

BZ  -  0. 


MAP08940 
MAP08950 
MAP08960 
MAP08970 
)  MAP08980 
MAP08990 
MAP09000 
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MAP09470 
B)MAP09480 
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Kiai 


oooo  oooo 


mapint.for 

CALL  BFIELD (ISWIT, X, Y, Z, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, D, 

1  COLLAP, DELXC, DYC, BRN, BRP, RN, RP, RADIUS, BX, BY, BZ) 

B  -  SQRT(BX**2  +  BY**2  +  BZ**2) 

DX  -  BX/B 
DYY  -  BY/B 
DZ  -  BZ/B 

RETURN 

END 

SUBROUTINE  CHECK (lYEAR, IDAY, IHOUR, MINUTE, ISCNDS, IFLAG) 

THIS  SUBROUTINE  CHECKS  THAT  THE  INTERACTIVE  INPUT  IS  WITHIN 
REASONABLE  LIMITS. 

IFLAG-0 

IF( (IYEAR.lt. 0) .OR. (IYEAR.GT.99) )THEN 
WRITE (6,*)'  INCORRECT  INPUT  FOR  YEAR-MUST  BE  BETWEEN  0  AND  99' 
IFLAG=  1 
RETURN 
ENDIF 

IF{ (IDAY.LT.l) .OR. (IDAY. GT. 366) ) THEN 
WRITE (6,*)'  INCORRECT  INPUT  FOR  DAY -MUST  BE  BETWEEN  1  AND  366' 
IFLAG-  1 
RETURN 
ENDIF 

IF( (IHOUR.lt. 0) .OR. (IHOUR. GT. 24) ) THEN 
WRITE (6,*)'  INCORRECT  INPUT  FOR  HOUR-MUST  BE  BETWEEN  1  AND  24' 

I FLAG-1 
RETURN 
ENDIF 

IF ( (MINUTE. LT.O) .OR. ( MINUTE. GT. 60) ) THEN 
WRITE (6,*)'  INCORRECT  INPUT  FOR  MINUTE-MUST  BE  BETWEEN  0  AND  60' 
IFLAG-  1 
RETURN 
ENDIF 

IF ( (ISCNDS. LT.O) .OR. (ISCNDS . GT . 60) ) THEN 
WRITE (6,*)'  INCORRECT  INPUT  FOR  SECONDS-MUST  BE  BETWEEN  0  AND  60 
IFLAG-  1 
RETURN 
ENDIF 
RETURN 
END 

SUBROUTINE  TCHECK (lYEAR, IDAY, IHOUR,MINUTE, ISCNDS, AUGPAR,AGPAR1, 

1  NAUGEL, IFLAG, ISTART) 

THIS  SUBROUTINE  CHECKS  TO  FIND  THE  RECORD  NUMBERS  OF  THE  DATA 
FILES  WHICH  SPAN  THE  REQUESTED  TIME. 

DIMENSION  AUGPAR (NAUGEL) , AGPARl (NAUGEL) , ISTART (3) , ITIME (3) 

IFLAG-0 

ITIME (l)-IYEAR 
ITIME (2) -IDAY 

ITIME(3)=IHOUR*3600  +  MINUTE*60  +  ISCNDS 
TIMCHK-TCONV3 (ITIME, ISTART) 

ITIME (1) -AUGPAR (1) 

ITIME (2) -AUGPAR (2) 

ITIME (3) -AUGPAR (3) *3600  +  AUGPAR(4)*60  +  AUGPAR(5) 

TIMAUG-TCONV3 (ITIME, ISTART) 

ITIME (1) -AGPARl (1) 

ITIME (2) -AGPARl (2) 

ITIME (3) -AGPARl (3) *3600  +  AGPARl (4) *60  +  AGPARl (5) 

TIMAG1-TCONV3 (ITIME, ISTART) 

IF( (TIMCHK.GE.TIMAUG) .AND. (TIMCHK. LT.TIMAGl) ) THEN 


MAP09580 

MAP09590 

MAP09600 

MAP09610 

MAP09620 

MAP09630 

MAP09640 

MAP09650 

MAP09660 

MAP09670 

MAP09680 

MAP09690 

MAP09700 

MAP09710 

MAP09720 

MAP09730 

MAP09740 

MAP09750 

MAP09760 

MAP09770 

MAP09780 

MAP09790 

MAP09800 

MAP09810 

MAP09820 

MAP09830 

MAP09840 

MAP09850 

MAP09860 

MAP09870 

MAP09880 

MAP09890 

MAP09900 

MAP09910 

MAP09920 

MAP09930 

MAP09940 

'MAP09950 

MAP09960 

MAP09970 

MAP09980 

MAP09990 

MAPIOOOO 

MAPlOOlO 

MAP10020 

MAP10030 

MAP10040 

MAP10050 

MAP10060 

MAP10070 

MAP10080 

MAP10090 

MAPlOlOO 

MAPlOllO 

MAP10120 

MAP10130 

MAP10140 

MAP10150 

MAP10160 

MAP10170 

MAP10180 

MAP10190 

MAP10200 

MAP10210 


on  ooooonoooooooooooooooooooo  o  o  o  oooooo  oo 


IFLAG=0 

ELSE 

IFLAG-1 

ENDIF 

RETURN 

END 


mapint.for 
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TC0NV3  ********** ********************mAP10280 


REAL  FUNCTION  TC0NV3 (ITIME, ISTART) 

THIS  FUNCTION  TAKES  A  START  YEAR,  START  DAY,  A  CURRENT  YEAR, 

A  CURRENT  DAY,  AND  A  CURRENT  SECOND..  IT  PRODUCES 
A  VALUE  THAT  IS  THE  SECONDS  FROM  THE  START  YEAR  AND  DAY. 

THIS  VALUE  IS  RELATIVE  TO  MIDNIGHT  OF  THE  START  DAY. 

PARAMETER  (IYR=>1,  IDY-2,  ISEC=3) 

DIMENSION  ITIME (3) , ISTART (3) 

INTRINSIC  REAL 

IF  (ISTART (lYR) .EQ. ITIME (lYR) )  THEN 

TEMP  -  REAL (ITIME (IDY)  -  ISTART (IDY) ) *86400 . 0  + 

1  REAL (ITIME (ISEC) ) 

ELSEIF  (MOD (ISTART (lYR) ,4) .EQ.O)  THEN 

TEMP  =  REAL (ITIME (IDY)  +  366  -  ISTART (IDY) ) *86400 . 0  + 

1  REAL (ITIME (ISEC) ) 

ELSE 

TEMP  -  REAL (ITIME (IDY)  +  365  -  ISTART (IDY) ) *86400 . 0  + 

1  REAL (ITIME (ISEC) ) 

ENDIF 

TCONV3  -  TEMP 
RETURN 

END 

SUBROUTINE  LOCATE (RVAL, PVAL, LATDIM, LTDIM, R, P, BI , BJ) 

PURPOSE:  FIND  GRID  LOCATION  (BI,BJ)  OF  PHYSICAL  LOCATIONS  GIVEN  BY 

(RVAL, PVAL, LL) 

VERSION  1.00  DATE:  01.22.90 


INPUT : 

RVAL  RADIAL  DISTANCE  (RE) 

PVAL  HOUR  ANGi,E  MEASURED  EASTWARD  FROM  NOON  (RADIAN) 

LATDIM  NUMBER  OF  LATITUDINAL  GRID  PTS 

LTDIM  MAX  NUMBER  OF  LOCAL  TIME  GRID  PTS  (INCL  WRAPAROUND) 
R  RADIAL  DISTANCE  ARRAY  (RE) 

P  HOUR  ANGLE  ARRAY  (RADIANS) 

OUTPUT : 

BI  NON-INTEGER  I  LOCATION  OF  (RVAL,XLT) 

BJ  NON-INTEGER  J  LOCATION  OF  (RVAL,XLT) 


PROGRAMMER:  R.W.  SPIRO 


DIMENSION  R (LATDIM, LTDIM) , P (LATDIM, LTDIM) 
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I 

I 
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mapint.for 


PI-ATAN2 ) 


C 

C 

C 

C 

C 

C 

C 

C 


c 

c 

c 

c 


c 

c 


SEARCH  GRID  AND  TRY  TO  LOCALIZE  (RVAL,PVAL)  WITHIN  A  GRID  SQUARE 
DO  30  J=2,LTDIM-2 
JJ-J 

DO  40  I-2,LATDIM 
II-I 

GET  PVAL,P(I,J),  AND  P(I,J+1)  IN  SAME  MODULUS 
CALL  PFIX(PVAL,P(I, J) ,P{I, J+1),P4,P5) 

WRITE (6, *)  I,  J,RVAL,R(I-1,  J,LL)  ,R(I, J,LL) ,PVAL,P4,P5 

IF(RVAL.LE.R(I-1, J) 

2  .AND. 

3  RVAL.GT.Rd,  J) 

4  .AND. 

5  PVAL.GE.P4 

6  .AND. 

7  PVAL.LT.P5) 

8  THEN 

GO  TO  50 
END  IF 

40  CONTINUE 
30  CONTINUE 

WRITE (6, »)  'STOPPING  IN  LOCATE' 

WRITE(6,*)  'UNABLE  TO  FIND  (BI,BJ)' 

WRITE (6,*)  'BVAL-  ' , RVAL, '  PVAL=  ' , PVAL 
STOP 


50  CONTINUE 

DO  45  IK-2, LATDIM 
IIK-IK 

IF{RVAL.LE.R(IK-1,J+1) .AND. RVAL. GT.R(IK,J+1) )  GO  TO  60 
45  CONTINUE 

WRITE (6,*)  'STOPPING  IN  EFLOC' 

WRITECe,*)  'UNABLE  TO  FIND  (BI,BJ)' 

WRI TE ( 6 , * )  ' RVAL-  ' , RVAL , '  PVAL-  ' , PVAL 
STOP 


C 

C 

C 


C 

C 

C 


60  CONTINUE 

COMPUTE  COEFFICIENTS  FOR  INTERPOLATION 

F1-(RVAL-R(II-1, JJ) ) / (R(II, JJ) -R(II-1, JJ) ) +FLOAT (II-l ) 
F2-(RVAL-R(IIK-1, JJ+1) ) / (R (IIK, JJ+1 ) -R (IIK-1 ,  JJ+1) )  + 

2  FLOAT (IIK-1) 

CALL  PFIX(XLT,P {II, JJ) ,P (IIK, JJ+1) ,P4,P5) 

BJ-(PVAL-P4) / (P5-P4)+FLOAT(JJ) 

IF (BJ . LT . 1 . )  BJ-BJ+FLOAT (LTDIM-3 ) 
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MAP11450 
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mapint.for 


IF (BJ.GT. FLOAT (LTDIM) )  BJ=BJ-FLOAT (LTDIM-3) 


BI-F1+ (BJ-FLOAT ( JJ) ) * (F2-F1 ) / (FLOAT ( JJ+1) -FLOAT ( JJ) ) 


RETURN 

END 

SUBROUTINE  PFIX (PI, P2, P3, P4, P5) 

PURPOSE:  SUBROUTINE  TO  ADJUST  MODULUS  OF  P2  AND  P3  TO  MATCH  PI. 

ON  OUTPUT  P4  CORRESPONDS  TO  P2,  P5  TO  P3 

VERSION  1.00  DATE:  09.04.89 

PROGRAMMER:  R.W.  SPIRO 


PI-ATAN2 (0. ,-l. ) 

P4-P2 

P5-P3 

IF(ABS(P2-P3) .GT.PI)  THEN 
IF(P2.LT.P3)  THEN 
P4-P2+2.*PI 
ELSE 

P5-P3+2.*PI 
END  IF 

IF (PI. LT. PI)  THEN 
P4-P4-2.*PI 
P5=P5-2.*PI 
END  IF 

END  IF 


RETURN 

END 

FUNCTION  G3NTRP (A, IMAX, UMAX, KMAX, BI, BJ, BK) 

VERSION  1.00  DATE:  01.11.88 

I.OIA  02.02.89 


PURPOSE:  FUNCTION  SUBPROGRAM  TO  PERFORM  A  GENERAL  3-D  LINEAR 

INTERPOLATION  OF  ARRAY  A(I,J,K)  AT  PT (BV (1 ) , BV (2) , BV (3) ) 


INPUT: 

A  3-D  ARRAY  TO  BE  INTERPOLATED 

INTERPOLATE  A 


COMMON  /LUNIT/LUERR, LUPPT, LUCORD, LUPRNT, LUIDAT, LUHDYE, 

1  LSPARE, LUETAB, LUEBEG, LUPLEC, LUPION, LUEAVG,  LUFLSM, LUETA, 

2  LUEFLX, LUEFLD, LUBFLD, LUBMIN, LUXMIN, LUYMIN,  LUZMIN, LUALOC, 

3  LUCOLT, LUBNDL, LUPDAT, LUVN, LUVS, LIONEG, LIONNO, LUENCH 
DIMENSION  AdMAX,  JMAX,KMAX) 

DIMENSION  NDX(3) ,NDIM(3) , BV (3) , COEF (3,  2) 

PREPARE  INDICES  FOR  INTERPOLATION 
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MAP11520 
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MAP11540 
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MAP11620 
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MAP11740 
MAP11750 
MAP11760 
MAP11770 
MAP11780 
MAP11790 
MAP11800 
MAP11810 
MAP11820 
MAP11830 
MAP11840 
MAP11850 
MAP11860 
MAP11870 
MAP11880 
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MAP11900 
MAP11910 
MAP11920 
MAP11930 
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MAP11980 
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MAP12010 
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MAP12030 
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MAP12080 
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MAP12110 
MAP12120 
MAP12130 
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20 


C 


mapint.for 


NDIM(1)=IMAX 
NDIM(2)»JMAX 
^  NDIM(3)-KMAX 

I  BV(1)-BI 

BV(2)=BJ 
.  BV(3)-BK 

DO  10  L“l,3 

I  NDX(L)=BV(L) 

IF(NDX(L) .LT.l)  NDX{L)=1 

I  IF(NDX(L) .GT.NDIM(L)-l)  NDX (L) =NDIM (L) -1 

IF(NDX(L) .LE.O)  NDX(L)=1 


FNDX=REAL(NDX{L) ) 

COEF (L, 1 ) =1 . -BV (L) +FNDX 
COEF  (L,  2)  =BV  (L)  -FNDX 
10  CONTINUE 


G3NTRP=0 . 

KSTOP  =  MIN(KMAX,2) 

JSTOP  -=  MIN  (UMAX,  2) 

DO  20  1=1,2 
DO  20  J=l, JSTOP 
DO  20  K=l, KSTOP 
G3NTRP=G3NTRP+ 

1  COEF (1,1) »COEF (2 , J) *COEF ( 3 , K) * A (NDX ( 1 ) +I -1 , NDX (2 ) + J-1 , 

2  NDX(3)+K-1) 

20  CONTINUE 

RETURN 

END 


SUBROUTINE  READ3D (LUN,  FILNAM,  LREC, IDIM, JDIM, KDIM, ITMDIM, ID, RID, 
2  CHID, ARRAY) 

PROGRAMMER:  BOB  SPIRO  DATE:  6/26/88 

PURPOSE:  THIS  SUBROUTINE  READS  A  LOGICAL  RECORD  FROM  THE 

STANDARD  MAGNETOSPHERIC  SPECIFICATIONS  MODEL  FILE  FORMAT. 


CHARACTER  CHID* 80,  FILNAM* 6 

DIMENSION  ARRAY (IDIM, JDIM, KDIM) 

DIMENSION  ID (20), RID (20) 

OPEN  THE  FILE 

IRECL  =  IDIM*JDIM  +  2*80 

OPEN  (UNIT=LUN, ACCESS=' DIRECT' , RECL=IRECL, STATUS=' OLD' ) 

READ  THE  ARRAY 

DO  10,  K=l,  KDIM 

CALCULATE  THE  RECORD  NUMBER 

IREC  -  (LREC-1) *KDIM  +  K 
READ  (LUN, REC= IREC)  ID, RID, CHID, 

2  ( (ARRAY (I, J, K) , 1=1, IDIM) , J=l, JDIM) 

10  CONTINUE 

C 

CLOSE (LUN) 
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mapint.for 


c 


RETURN 


C 


END 
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******************************  FNDBRK  ******************************MAP13060 


SUBROUTINE  FNDBRK (PARVAL, PVALS, IPDIM,MIN, MAX) 

THIS  SUBROUTINE  FINDS  THE  INDICES  OF  THE  VALUES  IN  ARRAY 
PVALS  THAT  BRACKET  PARVAL. 

BRYAN  BALES  9/12/89 

DIMENSION  PVALS (IPDIM) 

MIN  =  0 

CONTINUE 

MIN  =  MIN  +  1 
MAX  =  MIN  +  1 

IF  (PARVAL. LE. PVALS (MIN) )  THEN 
MAX  -  MIN 

ELSEIF  ( P ARVAL. GT. PVALS (MAX) .AND. MAX. EQ. IPDIM)  THEN 
MIN  -  MAX 

IF  (PARVAL. GT. PVALS (MAX) .AND.MAX.lt. IPDIM)  THEN 
GO  TO  10 
ENDIF 

RETURN 

END 
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LOGICAL  FUNCTION  MEXIST (MSTND,MTILT, MINED, MDST,MSTCH) 


THIS  FUNCTION  CHECKS  TO  SEE  IF  A  PARTICULAR  B-FIELD  IS 
AVAILABLE. 


CHARACTER* 32  FILNAM 
LOGICAL  TEST 


WRITE  (FILNAM, 1000)  MTILT, MSTND,MDST, MINED, (3-MSTCH) 
1000  FORMAT  ('BFIELD:BO' ,11,11,11,12.2,11,' .DAT' ) 


INQUIRE  (FILE=FILNAM,EXIST=TEST) 
MEXIST  “  TEST 


RETURN 

END 

SUBROUTINE  RDVEC (NOUNIT, IRDIN, lEMAX, lEDIM, ALAM, THRSH, ERSHFT, IFLAV) 

THIS  SUBROUTINE  READS  THE  HEADER  VECTOR  FOR  THE  ETA  FILES.  THE 
HEADER  CONTAINDS  THE  ALAM,  THRESHOLD  ENERGY,  AND  ERROR  INFORMATION 
FOR  THIS  RUN. 

MAP14560 
MAP14570 
MAP14580 
MAP14590 
MAP14600 

MAP14620 
MAP14630 

READ  (NOUNIT, REC=IRDIN)  lEMAX, ALAM, THRSH, ERSHFT, IFLAV 


DIMENSION  ALAM (lEDIM) , THRSH (lEDIM) , ERSHFT ( lEDIM) , IFLAV (lEDIM) 
OPEN  THE  FILE 

IRECL  -  4*iedim  +  1 

OPEN (UNIT=NOUNIT, ACCESS'' DIRECT' , RECL'IRECL, STATUS'' OLD' ) 

READ  VALUES 


mapint.for 


CLOSE  (NOUNIT) 

RETURN 

END 

SUBROUTINE  SETALM (ALAM, lEMAX, lEDIM, IFLAV,  ALMDEL) 

THIS  SUBROUTINE  READS  THE  NUMBER  OF  ENERGY  CHANNELS  AND  THEIR 
ENERGIES  AT  GEOSYNCHRONOUS  ORBIT  AND  CALCULATES  THE  ENERGY 
INVARIANTS  NEEDED  TO  RUN  THE  PROGRAM. 

THE  INPUT  ENERGY  IS  IN  EV  AND  MUST  BE  IN  ASCENDING  ORDER  SO  THAT  THE 
ALMDEL  VARIABLES  CAN  BE  CORRECTLY  CALCULATED. 


PARAMETER (VM6-7 . 0 ) 

DIMENSION  ALAM(IEDIM) 

DIMENSION  IFLAV (lEDIM) 

DIMENSION  ALMDEL (lEDIM) 

DIMENSION  NUM(3) 

DO  5  N-1,3 
NUM(N) =0 
5  CONTINUE 

COMPUTE  ALMDEL 

DO  20  IE=1,IEMAX 
ISP-IFLAV(IE) 

IF(NUM(ISP) .GE.2)  THEN 

IF(IE.EQ.1.0R.IFLAV(IE-1) .NE.ISP)  THEN 
ALMMIN=0 . 

ELSE 

ALMMIN-(ALAM(IE-1)+ALAM(IE) )/2. 

END  IF 

IF(IE.EQ.IEMAX.OR.IFLAV(IE+l) .NE.ISP)  THEN 
ALMMAX-1 . 5*ALAM (IE) -. 5*ALAM (IE-1) 

ELSE 

ALMMAX- (ALAM (IE) +ALAM (IE+1 ) ) /2 . 

END  IF 

ALMDEL (IE) =ABS (ALMMAX) -ABS (ALMMIN) 

END  IF 
20  CONTINUE 


RETURN 

END 

SUBROUTINE  BFIELD (ISWIT, X, Y, Z, STAND, TILT, HJNEAR, XNEAR, HJFRAC, DY, 
L  D,COLLAP, DELXC, DYC, BRN, BRP, RN, RP, RADIUS, 

>  BXTOT , BYTOT , BZTOT ) 


MAP14650 
MAP14660 
MAP14670 
MAP14680 
MAP14690 
MAP14700 
MAP14710 
MAP14720 
MAP14730 
MAP14740 
MAP14750 
MAP14760 
MAP14770 
MAP14780 
MAP14790 
MAP14800 
MAP14810 
MAP14820 
MAP14830 
MAP14640 
MAP14850 
MAP14860 
MAP14870 
MAP14880 
MAP14890 
MAP14900 
MAP14910 
MAP14920 
MAP14930 
MAP14940 
MAP14950 
MAP14960 
MAP14970 
MAP14980 
MAP14990 
MAP15000 
MAP15010 
MAP15020 
MAP15030 
MAP15040 
MAP15050 
MAP15060 
MAP15070 
MAP15080 
MAP15090 
MAP15100 
MAP15110 
MAP15120 
MAP15130 
MAP15140 
MAP15150 
MAP15160 
MAPI 51 70 
MAP15180 
MAP15190 
MAP15200 


PURPOSE-  CALLS  ALL  OF  THE  MAGNETIC  FIELD  MODEL  ROUTINES  FOR  A  MAP15180 
GIVEN  POINT  AND  SUMS  UP  THE  MAGNETIC  FIELD  VECTORS  (NO  MAPI 51 90 
CURRENT)  CONTRIBUTIONS.  THE  THREE  ROUTINES  ARE  BVOIGT,  MAP15200 
TAILC,  AND  RINGC,  REPRESENTING  A  SHIELDED  VACUUM  DIPOLE, MAP15210 
A  TAIL  CURRENT  SYSTEM,  AND  A  RING  CURRENT  SYSTEM, RESP.  MAP15220 
MUST  CALL  TWICE,  BEGINNING  WITH  ISWIT=0,  TO  CALCULATE  MAP15230 
AND  COLLECT  CONSTANTS.  THE  THIRD  AND  HIGHER  CALLS  GIVE  MAP15240 
RESULTS  FOR  SINGLE  POINTS  X,Y,Z  IN  GSM  COORDINATES.  MAP15250 

THE  COUNTER  ISWIT  IS  ADJUSTED  INTERNALLY  SO  IT  NEED  ONLYMAP15260 
BE  SPECIFIED  (-0)  FOR  THE  FIRST  CALL.  MAP15270 

INPUT-  ISWIT:  A  COUNTER,  VERY  FIRST  CALL  MUST  HAVE  ISWIT=0  MAP15280 


oo  on  oooooo  ooo 


mapint.for 


OUTPUT- 


X,Y,Z:  GSM  COORDINATES  IN  EARTH  RADII 
STAND:  STAND-OFF  DISTANCE  IN  RE 
TILT:  DIPOLE  TILT  ANGLE  IN  DEGREES 

BXTOT,BYTOT,BZTOT:  MAGNETIC  FIELD  COMPONENTS  IN  GAMMA 
HJXS,HJYS,HJZS:  CURRENT  DENSITY  COMPONENTS  (AMPS/M**2) 
THE  INPUT  VARIABLES  FOR  SUBROUT.  BVOIGT, TAILC,  AND 
RINGC  ARE  EXPLAINED  IN  EACH  RESPECTIVE  SUBROUT. 


VARIABLES-XNST, ZNST:  XGSM  AND  ZGSM  POSITIONS  OF  THE  CURRENT  SHEET 

IN  THE  NOON-MIDNIGHT  MERIDIAN.  SEGMENT 
BOUNDAFORM  XNST (I) , ZNST (I) 

BNST:  CURRENT  STRENGTH  AT  POINT  XNST (I) , ZNST (I)  ABOVE 
RADIUS;  MAGNETOPAUSE  RADIUS  IN  RE 

SUBROUTINES -GETRAD:  CALCULATES  RADIUS  FROM  STAND-OFF  DISTANCE 

BVOIOGT:  FINDS  VACUUM  SHIELDED  DIPOLE  CONTRIBUTIONS 
ZPOS:  CALCULATES  COEFFICIENTS  FOR  PLACEMENT  OF  TAIL 

CURRENT  SHEET 

SEGMNT:  FINDS  XNST, ZNST,  AND  BNST  FOR  NSTEP  SEGMENTS 
(NOT  CALLED  IF  HJNEAR  =  0) 

TAILC:  FINDS  TAIL  CURRENT  SHEET  CONTRIBUTIONS 
(NOT  CALLED  IF  HJNEAR  =0.) 

RINGC:  FINDS  RING  CURRENT  SYSTEM  CONTRIBUTIONS 
(NOT  CALLED  IF  BRN  =  BRP  =0.) 

TCOLLP:  FINDS  COLLAPSING  TAIL  CURRENT  CONTRIBUTIONS 
(NOT  CALLED  IF  COLLAP  =  1 . ) 

DIMENSION  XNST (50) , ZNST (50) , BNST (50) 

FIRST  CALL  MUST  HAVE  ISWIT  =  0 
ISWIT  =  ISWIT  +  1 

***  LIMIT  MAX  VALUE  OF  ISWIT  TO  4  *** 

IF  (ISWIT. GT. 3)  THEN 
ISWIT  =  4 
END  IF 

GET  BVOIGT  COEFFICIENTS 
IF  (ISWIT. EQ.l)  THEN 


SET  CONSTANTS  FOR  VACUUM  VOIGT  SHIELDED  DIPOLE  MODEL 
NO  PENETRATION  OF  IMF 
ALFA  =1.00 
CDIPOL  =0.0 
CIMF  =0.0 
BIMF  =0.0 
DIR  =0.0 

ZERO  QUANTITIES 
BXV  =  0. 

BYV  =  0. 

BZV  =  0. 

BXT  =  0. 

BYT  =  0. 

BZT  =  0. 

BXTC  =  0. 

BYTC  =  0. 

BZTC  -  0. 

BXR  =  0. 

BYR  -  0. 

BZR  -  0. 

GET  RADIUS  FROM  STAND 


MAP15290 
MAP15300 
MAP15310 
MAP15320 
MAP15330 
MAP15340 
MAP15350 
MAP15360 
MAP15370 
MAP15380 
MAP15390 
MAP15400 
MAP15410 
MAP15420 
MAP15430 
MAP15440 
MAP15450 
MAP15460 
MAP15470 
MAP15480 
MAP15490 
MAP15500 
MAP15510 
MAP15520 
MAP15530 
MAP15540 
MAP15550 
MAP15560 
MAP15570 
MAP15580 
MAP15590 
MAP15600 
MAP15610 
MAP15620 
MAP15630 
MAP15640 
MAP15650 
MAP15660 
MAP15670 
MAP15680 
MAP15690 
MAP15700 
MAP15710 
MAP15720 
MAP15730 
MAP15740 
MAP15750 
MAP15760 
MAP15770 
MAP15780 
MAP15790 
MAP15800 
MAP15810 
MAP15820 
MAP15830 
MAP15840 
MAP15850 
MAP15860 
MAP15870 
MAP15880 
MAP15890 
MAPI  5900 
MAP15910 
MAP15920 


mapintfor 


CALL  GETRAD (STAND, RADIUS) 

C  GET  COEFFICIENTS  FOR  BVOIGT 

CALL  BVOIGT (STAND, RADIUS, TILT, ALFA, CDIPOL, CIMF, BIMF, DIR, 

1  ISWIT,X,Y,Z,GARB1,GARB2, GARBS) 

END  IF 
C 

C  SET  CONSTANTS  IN  BVOIGT, SET-UP  TAIL  CURRENT  WITH  POSITION 

IF  (ISWIT.EQ.2)  THEN 

CALL  BVOIGT (STAND, RADIUS, TILT, ALFA,CDIPOL,CIMF, BIMF, DIR, 

1  ISWIT,X,y,  Z,GARB1,GARB2,(3ARB3) 

C  CALCULATE  COEFFICIENTS  FOR  CURRENT  SHEET  POSITION 

CALL  ZPOS(ISWIT,TILT,X,Z) 

C  ADVANCE  ISWIT  BECAUSE  ZPOS  CALLED  NEXT  IN  SEGMNT 

ISWIT  -  ISWIT  +  1 

C  CALCULATE  SEGMENT  BOUNDARIES  AND  CURRENT  STRENGTHS 

IF  (HJNEAR.NE.O. )  THEN 

CALL  SEGMNT (ISWIT, TILT, XNEAR, HJNEAR, HJFRAC,NSTEP, 

1  XNST,ZNST,BNST) 

END  IF 
END  IF 
C 

C  GET  POINT  VALUES 

IF  (ISWIT. EQ. 4)  THEN 

CALL  BVOIGT (STAND, RADIUS, TILT, ALFA, CDIPOL,  CIMF,  BIMF,  DIR, 

1  ISWIT, X, Y, Z,BXV,BYV,BZV) 

IF  (HJNEAR.NE.O.)  THEN 

CALL  TAILC (ISWIT, NSTEP, X, Y, Z, RADIUS, DY, D, XNST, ZNST, BNST, 

1  BXT,BYT,BZT) 

IF  (COLLAP.NE.l.)  THEN 

CALL  TCOLLP (ISWIT, NSTEP, X, Y, Z, RADIUS, DYC, D, XNST, ZNST, 

1  BNST, COLLAR, DELXC, BXTC, BYTC, BZTC) 

END  IF 
END  IF 

IF  ( (BRN.NE.O. ) .OR. (BRP.NE.O. ) )  THEN 

CALL  RINGC(X,Y, Z, TILT, BRN, BRP, RN, RP, BXR, BYR, BZR) 

END  IF 
C 

BXTOT  -  BXV  +  BXT  +  BXTC  +  BXR 

BYTOT  =  BYV  +  BYT  +  BYTC  +  BYR 

BZTOT  -  BZV  +  BZT  +  BZTC  +  BZR 

C 

END  IF 
C 

RETURN 

END 

C 

C*******************************  GETRAD 
C 

SUBROUTINE  GETRAD (STAND, RADIUS) 

C 

C  PURPOSE-  GIVES  MAGNETOTAIL  RADIUS  AS  A  FUNCTION  OF  THE  STAND-OFF 
C  DISTANCE. 

C  INPUT-  STAND:  THE  STAND-OFF  DISTANCE  (RE) 

C  OUTPUT-  RADIUS:  OF  THE  MAGNETOTAIL  (RE) 

C  VARIABLES-A0,A1,A2:  COEFFICIENTS 

C  MAXRAD:  UPPER  LIMIT  RADIUS  ALLOWED 

C  MINRAD:  LOWER  LIMIT  RADIUS  ALLOWED 

C  MXSTND:  UPPER  LIMIT  STAND-OFF  DISTANCE 

C  MNSTND:  LOWER  LIMIT  STAND-OFF  DISTANCE 

C  NOTE:  DERIVED  BY  MATCHING  STAND-OFF  DISTANCES  7,11,14  RE  WITH 
C  RADII  17,20,27  RE  RESPECTIVELY 

C 

AO  -  29.1660 
A1  -  -3.3214 


MAP15930 
MAP15940 
MAP15950 
MAP15960 
MAP15970 
MAP15980 
MAP15990 
MAP16000 
MAP16010 
MAP16020 
MAP16030 
MAP16040 
MAP16050 
MAP16060 
MAP16070 
MAP16080 
MAP16090 
MAP16100 
MAP16110 
MAP16120 
MAP16130 
MAP16140 
MAP16150 
MAP16160 
MAP16170 
MAP16180 
MAP16190 
MAPI 62 00 
MAP16210 
MAP16220 
MAP16230 
MAP16240 
MAP16250 
MAP16260 
MAP16270 
MAP16280 
MAP16290 
MAP16300 
MAP16310 
MAP16320 
MAP16330 
MAP16340 
MAP16350 
MAP16360 
MAP16370 
MAP16380 
MAP16390 
MAP16400 
MAP16410 
MAP16420 
MAP16430 
MAP16440 
MAP16450 
MAP16460 
MAP16470 
MAP16480 
MAP16490 
MAP16500 
MAP16510 
MAP16520 
MAP16530 
MAP16540 
MAP16550 
MAPI  6560 


o  o 


mapint.for 


A2  -  0.2262  MAP16570 

MAXRAD  -  27.  MAP16580 

MINRAD  -  17.  MAP16590 

MXSTND  -  14.  MAP16600 

MNSTND  -  7.  MAP16610 

MAP16620 

MAP16630 

IF  ( STAND. GT.MXSTITO)  THEN  MAP16640 

RADIUS  -  MAXRAD  MAP16650 

STAND  -  MXSTND  MAP16660 

ELSE  MAP16670 

IF  (STAND.lt. MNSTND)  THEN  MAP16680 

RADIUS  -  MINRAD  MAP16690 

STAND  *  MNSTND  MAPI 6700 

ELSE  MAP16710 

RADIUS  =  AO  +  A1*STAND  +  A2* (STAND**2)  MAP16720 

END  IF  MAP16730 

END  IF  MAP16740 

MAP16750 

RETURN  MAPI 67 60 

END  MAP16770 

A*******************************  tAILC  MAP16780 

SUBROUTINE  TAILC (ISWIT, NSTEP, XGSM,YGSM, ZGSM, RADIUS, DY, D, XNST, ZNST,MAP16790 


IF  (STAND. GT.MXSTITO)  THEN 
RADIUS  -  MAXRAD 
STAND  -  MXSTND 
ELSE 

IF  (STAND.lt. MNSTND)  THEN 


RADIUS  -  MINRAD 
C  STAND  *  MNSTND 

ELSE 

RADIUS  =  AO  +  A1*STAND  +  A2* (STAND**2) 
END  IF 
END  IF 
C 

RETURN 
END 

Q************************************* 


PURPOSE- 


BNST,BX,BY,BZ)  MAP16800 

MAP16810 

MAP16820 

CALCULATE  THE  MAGNETIC  FIELD  AND  CURRENTS  DUE  TO  A  MAP16830 

CROSSTAIL  CURRENT  SHEET.  MULTIPLE  CURRENT  SEGMENTS  ARE  MAP16840 
JOINED  EDGE  TO  EDGE.  THE  CURRENT  STRENGTH  AND  POSITION  MAP16850 
AS  A  FUNCTION  OF  XGSM  ARE  ARBITRARY  AND  PROVIDED.  MAP16860 

A  YGSM  DEPENDENCE  IS  ALSO  INCLUDED.  INSPIRATION  FOR  MAP16870 
THIS  MODEL  CAN  BE  FOUND  IN  MAP16880 


FUNCTION  OF  XGSM  ARE  ARBITRARY  AND  PROVIDED.  MAP16860 
3M  DEPENDENCE  IS  ALSO  INCLUDED.  INSPIRATION  FOR  MAP16870 
MODEL  CAN  BE  FOUND  IN  MAP16880 
TSYGANENKO  &  USMANOV,  PLANETARY  AND  SPACE  SCIENCE,  MAP16890 


INPUT- 


VOL.  30,  PP.  985-998,  1982  MAP16900 

MAP16910 

ISWIT:  COUNTER  USED  IN  SUBROUT.  ZPOS  MAP16920 

NSTEP:  NUMBER  OF  CURRENT  SEGMENTS  COMPRISING  THE  TAIL  MAP16930 
XGSM, YGSM, ZGSM:  THE  GEOCENTRIC  SOLAR  MAGNETOSPHERIC  MAP16940 
COORDINATE  (EARTH  RADII)  MAP16950 

ALL  REFERENCES  TO  DISTANCE  ARE  MADE  IN  EARTHMAP16960 


OUTPUT- 


RADII  IN  THE  GSM  COORDINATE  SYSTEM. 

RADIUS:  (RE)  OF  MAGNETOTAIL 

DY:  CHAR.  WIDTH  FOR  Y  DEPENDENCE  OF  BX  AND  BZ 
D:  HALF-WIDTH  OF  CURRENT  FILAMENTS 

XNST,ZNST:  LOCATION  OF  CURRENT  SHEET  IN  GSM  X  AND  Z 
BNST:  CURRENT  STRENGTH  AT  XNST, ZNST 

BX,BY,BZ  MAGNETIC  FIELD  COMPONENTS  IN  GSM  (GAMMAS) 
HJX,HJY,HJZ  CURRENT  DENSITY  IN  GSM  (AMPS/METER**2) 


VARIABLES-XN,XF:  NEAR  AND  FAR  EDGES  OF  A  CURRENT  SEGMENT 

ZN,ZF:  NEAR  AND  FAR  ZGSM  POSITION  OF  CURRENT  SEGMENT 


MAP16970 

MAP16980 

MAP16990 

MAP17000 

MAP17010 

MAP17020 

MAP17030 

MAP17040 

MAP17050 

MAP17060 

MAP17070 


BN,BF:  VALUES  OF  B  AT  XN  AND  XF (REALLY  CURRENT  STRENGTH) MAPI 7080 
DELX:  STEP  SIZE  =  (XN-XF)  MAP17090 

FY:  VALUE  OF  Y-DEPENDENT  FUNCTION  (SEE  SUBROUT.  YYY)  MAP17100 
FYP:  FIRST  DERIVATIVE  OF  Y-DEPENDENT  FUNCTION  ABOVE  MAP17110 
DELB:  “(BN-BF)  MAP17120 

DD:  =  DELB/DELX  MAP17130 

SLOPE:  SLOPE  OF  A  SEGMENT  = (ZF-ZN) / (XF-XN)  MAP17140 

RADIUS:  RADIUS  OF  MAGNETOTAIL  IN  RE  MAP17150 

FACTJ:  FACTOR  TO  GET  CURRENT  IN  UNITS  AMPS/METER**2  MAP17160 

-  (1/MAGNETIC  PERM) * (TESLA/GAMMA) * (RE/METER)  MAP17170 

-  (l/(4*PI*lE-07))*(lE-09)*(l/(6.370E+06))  MAP17180 

=  1.249E-10  MAP17190 

ALL  OTHER  VARIABLES  ARE  PRESENT  FOR  CONVENIENCE  AND  HAVEMAP17200 


mapint.for 

c 

NO  PARTICULAR  PHYSICAL  MEANINGS  IN  MOST 

CASES. 

MAP17210 

c 

MAP17220 

C  SUBROUT.-  YYY:  RETURNS  VALUE  OF  YGSM  FUNCTIONAL  DEPENDENCE 

AND  THEMAP17230 

C 

FIRST  DERIVATIVE  W.R.T.  YGSM  AT  A  GIVEN  YGSM  MAP17240 

c 

MAP17250 

c 

MAP17260 

I 

)IMENSION  XNST(50) ,ZNST(50) ,BNST(50) 

MAP17270 

FACTJ  -  1.249E-10 

MAP17280 

C 

MAP17290 

BX  »  0. 

MAP17300 

E 

JY  -  0. 

MAP17310 

E 

JZ  -  0. 

MAP17320 

C 

MAP17330 

C 

CALCULATE  CONTRIBUTIONS  FROM  NSTEP  CUIUIENT  SEGMENTS  TO 

B-FIELDMAP17340 

I 

)0  10  N  -  1,  NSTEP 

MAP17350 

c 

MAP17360 

XN  -  XNST(N) 

MAP17370 

XF  -  XNST(N+1) 

MAP17380 

DELX  -  XN  -  XF 

MAP17390 

ZN  «  ZNST{N) 

MAP17400 

ZF  -  ZNST(N+1) 

MAP17410 

SLOPE  =  (ZF  -  ZN)/(XF  -  XN) 

MAP17420 

c 

MAP17430 

BN  -  BNST(N) 

MAP17440 

BF  =  BNST(N+1) 

MAP17450 

DELB  -  BN  -  BF 

MAP17460 

c 

MAP17470 

DD  -  DELB/DELX 

MAP17480 

QB  -  BN  -  DD*XN 

MAP17490 

c 

MAP17500 

c 

CONSTANTS  INVOLVED  IN  INTEGRATION:  A,B,C  ARE  COMMON 

TO  BOTHMAP17510 

c 

THE  BX  AND  BZ  EXPRESSIONS,  BY  = 

0 

MAP17520 

c 

MAP17530 

A  -  1.  +  SLOPE**2 

MAP17540 

B  “  -2,*(XGSM  +  SLOPE* (ZGSM  -  ZN  +  SLOPE*XN) ) 

MAP17550 

C  =  XGSM**2  +  (ZGSM  -  ZN  +  SLOPE*XN)**2  +  D**2 

MAP17560 

BDX  -  -2. 

MAP17570 

BDZ  -  -2.*SLOPE 

MAP17580 

CDX  -  2.*XGSM 

MAP17590 

CDZ  -  2,* (ZGSM  -  ZN  +  SLOPE*XN) 

MAP17600 

c 

MAP17610 

c 

TEST  FOR  PROPER  INTEGRAL  FORM,  ONLY  THE  FORM 

FOR  ABC 

>  0  HAVEMAP17620 

c 

BEEN  INCLUDED.  NO  EXCEPTIONS  FOUND  TO  DATE 

MAP17630 

c 

MAP17640 

ABC  “  4.*A*C  -  B**2 

MAP17650 

SABC  -  SQRT(ABC) 

MAP17660 

IF  (ABC.LE.O.)  THEN 

MAP17670 

GOTO  15 

MAP17680 

END  IF 

MAP17690 

c 

MAP17700 

c 

SOME  CONSTANTS  FOR  BX  EXPRESSION 

MAP17710 

c 

MAP17720 

CMX  -  -SLOPE*DD 

MAP17730 

CNX  -  -SLOPE*QB  +  DD* (SLOPE*XN  +  ZGSM  -  ZN) 

MAP17740 

CPX  -  (oLOPE*XN  +  ZGSM  -  ZN) *QB 

MAP17750 

c 

MAP17760 

c 

SOME  CONSTANTS  FOR  BZ  EXPRESSION 

MAP17770 

c 

MAP17780 

CMZ  -  DD 

MAP17790 

CNZ  -  BN  -  DD* (XN  +  XGSM) 

MAP17800 

CPZ  -  -XGSM*QB 

MAP17810 

c 

MAP17820 

c 

SOME  COMMON  FACTORS  FOR  BOTH  BX  AND  BZ 

MAP17830 

c 

MAP17840 

WLN  - 
WATAN 


mapint.for 

LOG ( (A*XN**2+B*XN+C) / (A*XF**2+B*XF+C) )  MAP17850 

-  ATAN( (2*A*XN+B) /SABO  -  ATAN ( {2*A*XF+B) /SABC)  MAP17860 

MAP17870 

IE  BX  FUNCTION  MAP17880 

MAP17890 

CLNX  -  (A*CNX  -  B*CMX)/(2.*{A**2))  MAP17900 

CTANX  =  (2.*A*(A*CPX-C*CMX)-B*(A*CNX-B*CMX))/((A**2)*SABC)  MAP17910 

BX  -  BX  +  (CMX*DELX) /A  +  CLNX*WLN  +  CTANX*WATAN  MAP17920 

MAP17930 

THE  BZ  FUNCTION  MAPI 7 940 

MAP17950 

CLNZ  -  (A*CNZ  -  B*CMZ) / (2.* (A**2) )  MAP17960 

CTANZ  -  (2.*A*(A*CPZ-C*CMZ)-B*(A*CNZ-B*CMZ))/((A**2)*SABC)  MAP17970 

BZ  -  BZ  +  (CMZ*DELX)/A  +  CLNZ*WLN  +  CTANZ*WATAN  MAP17980 

MAP17990 

CONTINUE  MAPI 8000 

MAP18010 

GET  YGSM  DEPENDENCE  AND  FIRST  DERIVATIVE  MAP18020 

CALL  YYY (YGSM, DY, RADIUS, FY,FYP)  MAP18030 

MAP18040 

NOW  INCLUDE  THE  YGSM  DEPENDENCE  IN  B-FIELD  AND  CURRENT  MAP18050 

BX  =  BX*FY  MAP18060 

BY  =  0.  MAP18070 

BZ  -  BZ*FY  MAP18080 

GOTO  20  MAP18090 

MAP18100 

CONTINUE  MAP18110 

WRITE (6, 99)  MAP18120 

FORMAT (IHl, 'WRONG  EQUATION  USED,  OUTPUT  SET  TO  ZERO')  MAP18130 

BX  -  0.  MAP18140 

BY  -  0.  MAPI 8150 

BZ  -  0.  MAP18160 

MAP18170 

CONTINUE  MAP18180 

RETURN  MAP18190 

END  MAPI 82 00 

MAP18210 

***************************  hJSIZE  MAP18220 

MAP18230 

HJSIZE (X,XNEAR,HJNEAR,HJFRAC)  MAP18240 

MAP18250 

CALCULATE  RELATIVE  CURRENT  STRENGTH  ALONG  MIDNIGHT  MAPI 8260 

MERIDIAN  AT  A  GIVEN  XGSM  POSITION.  FUNCTION  IS  ARBI TRARYMAPl 8270 
X:  XGSM  POSITION  MAP18280 

XNEAR:  TAIL  CURRENT  INNER  EDGE  DISTANCE  (NEG.  TAILWARD)  MAP18290 

HJNEAR:  HJSIZE  AT  XNEAR  MAP18300 

HJFRAC:  FRACTION  OF  HJNEAR  FOUND  AT  -100  RE  MAP18310 

HJSIZE:  STRENGTH  OF  CROSSTAIL  CURRENT  MAP18320 


C 

c 


PURPOSE- 


INPUT- 


§  I 


FUNCTION  HJSIZE (X, XNEAR, HJNEAR, HJFRAC) 


HJNEAR:  HJSIZE  AT  XNEAR  MAP18300 

HJFRAC:  FRACTION  OF  HJNEAR  FOUND  AT  -100  RE  MAP18310 

OUTPUT-  HJSIZE:  STRENGTH  OF  CROSSTAIL  CURRENT  MAP18320 

VARIABLES-BFLAT:  X  POSITION  WHERE  HJSIZE  LEVELS  OFF  TO  CONSTANT  REMAP18330 


NOTE:  BFLAT  IS  SET  AT  -100.  RE,  AN  AD  HOC  VALUE 
EXPON:  EXPONENTIAL  DECREASE  OF  CURRENT  DENSITY 

BFLAT  «  -100. 

EXPON  -  LOG (HJFRAC) / (BFLAT  -  XNEAR) 

IF  (X.GT. XNEAR)  THEN 
HJSIZE  =  0. 

GOTO  10 
END  IF 

IF  (X.GT. (BFLAT) )  THEN 

HJSIZE  =  HJNEAR*EXP (EXPON* (X  -  XNEAR)) 

ELSE 

HJSIZE  =  HJNEAR*HJFRAC 
END  IF 


MAP18340 

MAP18350 

MAP18360 

MAP18370 

MAP18380 

MAP18390 

MAP18400 

MAP18410 

MAP18420 

MAP18430 

MAP18440 

MAP18450 

MAP18460 

MAP18470 

MAP18480 


oo  oo  on  o  o  o  o  oooooooooooooooooo  ooo 


mapint.for 


CONTINUE 
RETURN 
END 

'kititiUfklrititiritlciiiiititirititiririticitiricicirit'iririritfiicitii 


ZPOS 


SUBROUTINE  ZPOS (ISWIT, TILT, XGSM, ZGSM) 


MAP18490 

MAP18500 

MAP18510 

MAP18520 

MAP18530 

MAP18540 

MAP18550 

MAP18560 

MAP18570 

MRP18580 

MAP18590 

MAP18600 


PURPOSE-  CALCULATE  ZGSM  POSITION  OF  CURRENT  SHEET  IN 
MIDNIGHT  MERIDIAN 
INPUT-  TILT:  DIPOLE  TILT  ANGLE 

ISWIT:  COUNTER  SO  COEFFICIENTS  ONLY  CALCULATED  ONCEMAP18610 
XGSM:  COORDINATE  OF  INTEREST  MAP18620 

ZGSM:  CURRENT  SHEET  ELEVATION  W.R.T,  THE  XGSM  ^OflS  MAP18630 


OUTPUT- 
VARIABLES-Cl : 

C2: 

C3: 

C4: 

C5: 


XGSM  WHERE  CURVE  LEVELS  OFF,  ZERO  SLOPE 
XGSM  WHERE  CURVE  LEAVES  XSM  AXIS 
ZGSM  AT  XGSM=C2 
ZGSM  AT  XGSM>=C1 

SLOPE  OF  XSM  AXIS  IN  GSM  FRAME  AT  C2 
RTILT:  DIPOLE  TILT  IN  RADIANS 

HINGE:  CURRENT  SHEET  HINGE  POSITION,  SET  =  9 .  RE 
AFTER  GOSLING,  JGR,  7093,  1986 
A0,A1,A2,A3:  COEFFICIENTS  OF  POLYNOMIAL  FIT 
Z  =  AO  +  A1*X  +  A2*X**2  +  A3*X**3 


IF 


(ISWIT. LE. 2)  THEN 
CALCULATE  COEFFICIENTS 
HINGE  -  9. 

DEG  -  ACOS(-1.00)/180. 
RTILT  -  DEG*TILT 


Cl  -  4.  -  HINGE* (1.  +  COS (RTILT)) 

C2  =  -4.*COS(RTILT) 

C3  =  4.*SIN(RTILT) 

C4  -  HINGE*SIN (RTILT) 

C5  -  -TAN (RTILT) 

Q1  -  3.*(C1**2)*C2  -  C2**3 
Q2  «■  -2.*C1*C2  +  C2**2 
Q3  -  C2  -  Cl 
Q4  -  C2**2  -  Cl**2 

A3  -  (2.* (C4-C3)+C5*Q3) / (3.*Q3*Q4+2.* (Ql-2.* (Cl**3) ) ) 
A2  =  (C5  -  3.*A3*Q4) / (2.*Q3) 

A1  -  -2.*A2*C1  -  3.*A3* (Cl**2) 

AO  =  C3  -  A2*Q2  +  A3*Q1 
END  IF 

INSIDE  CURVE  LIMIT  USE  XSM  AXIS 
IF  (XGSM.GT.C2)  THEN 
ZGSM  -  XGSM*C5 
END  IF 

BETWEEN  XGSM  C2  AND  Cl,  FITTED  CURVE  IS  USED 
IF  ( (XGSM. LE.C2) .AND. (XGSM. GE. Cl) )  THEN 

ZGSM  «  AO  +  A1*XGSM  +  A2* (XGSM**2)  +  A3* (XGSM**3) 

END  IF 

OUTSIDE  CURVE  LIMIT  USE  LINE  PARALLEL  TO  XGSM  AXIS 
IF  (XGSM. LT. Cl)  THEN 
ZGSM  -  C4 
END  IF 


MAP18640 

MAP18650 

MAP18660 

MAP18670 

MAP18680 

MAP18690 

MAP18700 

MAP18710 

MAP18720 

MAP18730 

MAP18740 

MAP18750 

MAP18760 

MAP18770 

MAP18780 

MAP18790 

MAP18800 

MAP18810 

MAP18820 

MAP18830 

MAP18840 

MAP18850 

MAP18860 

MAP18870 

MAP18880 

MAP18890 

MAP18900 

MAP18910 

MAP18920 

MAP18930 

MAP18940 

MAP18950 

MAP18960 

MAP18970 

MAP18980 

MAP18990 

MAP19000 

MAP19010 

MAP19020 

MAP19030 

MAP19040 

MAP19050 

MAP19060 

MAP19070 

MAP19080 

MAP19090 

MAP19100 

MAP19110 

MAP19120 


oo  oo  ooooooooooooooooooooo  ooo  n  o  o  000000000  00 
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RETURN 

END 

********************************  yyy 

SUBROUTINE  YYY (Y, DY, RAD, FY, FYP) 


PURPOSE- 


INPUT- 


OUTPUT- 


CALCULATE  YGSM  DEPENDENCE  AND  FIRST  DERIVATIVE 

FY  =  0  AT  Y  =  RADIUS 

Y:  YGSM  POSITION  (EARTH  RADII) 

RAD:  RADIUS  OF  MAGNETOTAIL 
DY:  CHARACTERISTIC  WIDTH  OF  Y  DEPENDENCE 
FY:  FUNCTIONAL  VALUE  OF  YGSM  DEPENDENCE  AT  Y 
FYP:  FIRST  DERIVATIVE  OF  FY  W.R.T  Y 


YEXP  -  -(Y/DY)**2 
IF  (YEXP.LT. (-40.) )  THEN 
FY  -  0. 

FYP  -  0. 

GOTO  10 
FND  IF 

PI  -  ACOS(-l.OO) 

CY  -  COS(PI*Y/(2.*RAD)) 

SY  -  SIN(PI*Y/ (2.*RAD) ) 

FY  -  CY*EXP(-(Y/DY)**2) 

FYP-  (-2.*Y*CY/ (DY**2)  -  PI*SY/ (2 . *RAD) ) *EXP (- (Y/DY) **2) 

10  CONTINUE 

RETURN 

END 

********************************  rinGC 

SUBROUTINE  RINGC (XGSM, YGSM, ZGSM, TILT, BRN,  BRP,  RN, RP, 

1  BXGSM, BYGSM, BZGSM) 

PURPOSE-  CALCULATE  MAGNETIC  FIELD  AND  CURRENT  COMPONENTS  OF  RING 
CURRENT  TILTED  WITH  THE  DIPOLE 
INPUT-  XGSM, YGSM, ZGSM:  GSM  COORDINATES  IN  RE 

TILT:  TILT  IN  DEGREES  OF  CENTRAL  AXIS  OF  RINGS,  ALIGNED 
WITH  DIPOLE  AXIS.  POSITIVE  FOR  N.  HEMISPHERE  SUMM 
BRN:  NEGATIVE  BZ  CONTRIBUTION  FOR  ZERO  TILT  AT  (0,0,0) 
FROM  THE  WESTWARD  CURRENT 

BRP:  POSITIVE  BZ  CONTRIBUTION  FROM  EASTWARD  CURRENT 
RN:  CHARACTERISTIC  RADIUS  (IN  RE)  OF  WESTWARD  RING 
RP:  CHARACTERISTIC  RADIUS  (IN  RE)  OF  EASTWARD  RING 
BXGSM, BYGSM, BZGSM:  MAGNETIC  FIELD  COMPONENTS  OF  RING 

IN  GAMMAS 

OUTPUT-  FACTJ:  CONSTANT  USED  TO  ADJUST  UNITS  OF  CURRENT,  SEE 
VARIABLES-BR:  SUBROUT.  TAILC  FOR  DERIVATION 

RHO,PHI,Z;  CYLINDRICAL  COORDINATE  SYSTEM 
SUBROUTINES-  TRANS6:  CHANGES  GSM  CARTESIAN  TO  SM  CYLINDRICAL 

VTRAN6:  CHANGES  SM  CYLINDRICAL  VECTORS  TO  GSM  SYSTEM 


OUTPUT- 


FACTOR  TO  MAKE  CURRENT  OUTPUT  IN  AMPS/M**2 
FACTJ  -  1.249E-10 
PI  -  ACOS(-l.OO) 

CHANGE  GSM  TO  SM  CYLINDRICAL  COORDINATES 
CALL  TRANS6 (TILT, XGSM, YGSM, ZGSM, RHO, PHI , Z) 

SCALE  FACTOR  (PUT  Z  AND  RHO  INTO  UNITS  OF  CHAR.  RADII) 


MAP19130 

MAP19140 

MAP19150 

MAP19160 

MAP19170 

MAP19160 

MAP19190 

MAP19200 

MAP19210 

MAP19220 

MAP19230 

MAP19240 

MAP19250 

MAP19260 

MAP19270 

MAP19280 

MAP19290 

MAP19300 

MAP19310 

MAP19320 

MAP19330 

MAP19340 

MAP19350 

MAP19360 

MAP19370 

MAP19380 

MAP19390 

MAP19400 

MAP19410 

MAP19420 

MAP19430 

MAP19440 

MAP19450 

MAP19460 

MAP19470 

MAP19480 

MAP19490 

MAP19500 

MAP19510 

MAP19520 

MAP19530 

.MAP19540 

MAP19550 

MAP19560 

MAP19570 

MAP19580 

MAP19590 

MAP19600 

MAP19610 

MAP19620 

MAP19630 

MAP19640 

MAP19650 

MAP19660 

MAP19670 

MAP19680 

MAP19690 

MAP19700 

MAP19710 

MAP19720 

MAP19730 

MAP19740 

MAP19750 

MAP19760 


S  I 


ooo  o  o  oo  ooooooooooo  ooo  no  oo 


ZN  »  Z/RN 
RHON  -  RHO/RN 
ZP  -  Z/RP 
RHOP  -  RHO/RP 


mapint,for 


COMMON  FACTORS 
AN  -  RHON**2  +  ZN**2  +  4. 

BN  -  2.*(ZN**2)  -  <RHON**2)  +  8. 
AP  -  RHOP**2  +  ZP**2  +  4, 

BP  -  2.*(ZP**2)  -  (RHOP**2)  +  8. 


CYLINDRICAL  BFIELD 

BRHO  -  12.*BRN*RHON*ZN/SQRT(AN**5)  +  12 . *BRP*RHOP*ZP/SQRT (AP**5) 
BPHI  -  0. 

BZ  -  4.*BRN*BN/SQRT(AN**5)  +  4 . *BRP*BP/SQRT (AP**5) 


CHANGE  VECTOR  QUANTITIES  BACK  TO  GSM  COORDINATES 
CALL  VTRAN6 (BRHO, BPHI, BZ, PHI, TILT, BXGSM,  BYGSM,  BZGSM) 


RETURN 

END 


***************************  TRANS6 

SUBROUTINE  TRANS6 (TILT, XGSM, YGSM, ZGSM, RHO,  PHI,  Z) 

PURPOSE-  CHANGE  GSM  CARTESIAN  TO  SM  CYLINDRICAL  COORDINATES 
INPUT-  TILT:  DIPOLE  TILT  IN  DEGREES 

XGSM, YGSM, ZGSM:  GSM  COORDINATES 
OUTPUT-  RHO, PHI, Z:  CYLINDRICAL  COORDINATES  OF  SM  SYSTEM 
UNITS  (RE, RADIANS, RE) 

VARIABLES-RTILT:  TILT  ANGLE  IN  RADIANS 

PI  »  ACOS(-l.OO) 

RTILT  -  TILT* (PI/180. ) 

CHANGE  GSM  TO  SM  COORDINATES 
XSM  -  XGSM*COS (RTILT)  -  ZGSM*SIN (RTILT) 

YSM  -  YGSM 

ZSM  -  XGSM*SIN (RTILT)  +  ZGSM* COS (RTILT) 

RHO  -  SQRT(XSM**2  +  YSM* *2) 

IF  (RHO.EQ.O.)  THEN 
RHO  »  0.000001 
END  IF 

PHI  -  ACOS(XSM/RHO) 

IF  (YSM.LT.O.)  THEN 

PHI  -  PHI  +  2.*  (PI  -  PHI) 

END  IF 
Z  -  ZSM 

RETURN 

END 

*********************  VTRAN6 


C 

C 

C 

C 

C 

C 

C 


SUBROUTINE  VTRAN6 (VRHO, VPHI , VZ, PHI , TILT, VXGSM, VYGSM, VZGSM) 

PURPOSE-  CHANGE  VECTOR  QUAN'^ITIES  OF  JM  CYLINDRICAL  TO 
VECTORS  OF  GSM  COORDINATES 
INPUT-  VRHO,VPHI, VZ:  RHO, PHI, Z  VECTORS 
PHI:  ANGLE  PHI  IN  RADIANS 
TILT:  DIPOLE  TILT  ANGLE  IN  DEGREES 
OUTPUT-  VXGSM, VYGSM, VZGSM:  GSM  VECTOR  COMPONENTS 


MAP19770 
MAPI 9780 
MAP19790 
MAP19800 
MAP19810 
MAP19820 
MAP19830 
MAP19840 
MAP19850 
MAP19860 
MAP19870 
MAP19880 
MAP19890 
MAP19900 
MAP19910 
MAP19920 
MAP19930 
MAP19940 
MAP19950 
MAP19960 
MAP19970 
MAP19980 
MAP19990 
MAP20000 
MAP20010 
MAP20020 
MAP20030 
MAP20040 
MAP20050 
MAP20060 
MAP20070 
MAP20080 
MAP20090 
MAP20100 
MAP20110 
MAP20120 
MAP20130 
MAP20140 
MAP20150 
MAP20160 
MAP20170 
MAP20180 
MAP20190 
MAP20200 
MAP20210 
MAP20220 
MAP20230 
MAP20240 
MAP20250 
MAP20260 
MAP20270 
MAP20280 
MAP20290 
MAP20300 
MAP20310 
MAP20320 
MAP20330 
MAP20340 
MAP20350 
MAP20360 
MAP20370 
MAP20380 
MAP20390 
MAP20400 


o  o  o  o  o  o 


mapint.for 

c**** 


VARIABLES-RTILT:  DIPOLE  TILT  ANGLE  IN  RADIANS 

PI  -  ACOS(-l.OO) 

RTILT  -  TILT* (PI/180. ) 

CHANGE  CYLINDRICAL  TO  CARTESIAN  (BOTH  SM) 

VXSM  -  VRHO*COS (PHI)  -  VPHI*SIN (PHI ) 

VYSM  -  VRHO*SIN(PHI)  +  VPHI*COS (PHI) 

VZSM  -  VZ 

CHANGE  SM  TO  GSM 

VXGSM  -  VXSM*COS (RTILT)  +  VZSM*SIN (RTILT) 

VYGSM  -  VYSM 

VZGSM  -  -VXSM*SIN (RTILT)  +  VZSM*COS (RTILT) 

RETURN 

END 


*********************************  TCOLLP 
SUBROUTINE  TCOLLP (ISWIT, NSTEP, XGSM, YGSM, ZGSM, RADIUS, DYC, D, 
1  XNST, ZNST, BNST, COLLAP, DELXC, BX, BY, BZ) 


SPECIAL  COLLAPSE  OF  TAIL  SIMUALTION,  INTRODUCES  LESSER 


MAP20410 

MAP20420 

MAP20430 

MAP20440 

MAP20450 

MAP20460 

MAP20470 

MAP20480 

MAP20490 

MAP20500 

MAP20510 

MAP20520 

MAP20530 

MAP20540 

MAP20550 

MAP20560 

MAP20570 

MAP20580 

MAP20590 

MAP20e00 

MAP20610 

MAP20620 

MAP20630 

MAP20640 

MAP20650 


CURRENT  IN  OPPOSITE  DIRECTION  AT  NEAR  PART  OF  TAIL,  ADDED  TO  MAP20660 
REGULAR  CURRENT.  MAP20670 

*****  MAP20680 

PURPOSE-  CALCULATE  THE  MAGNETIC  FIELD  AND  CURRENTS  DUE  TO  A  MAP20690 

CROSSTAIL  CURRENT  SHEET.  MULTIPLE  CURRENT  SEGMENTS  ARE  MAP20700 
JOINED  EDGE  TO  EDGE.  THE  CURRENT  STRENGTH  AND  POSITION  MAP20710 
AS  A  FUNCTION  OF  XGSM  ARE  ARBITRARY  AND  PROVIDED.  MAP20720 

A  YGSM  DEPENDENCE  IS  ALSO  INCLUDED.  MAP20730 

MAP20740 

r-  ISWIT:  COUNTER  USED  IN  SUBROUT.  ZPOS  MAP20750 

NSTEP:  NUMBER  OF  CURRENT  SEGMENTS  IN  TAIL  MAP20760 

XGSM, YGSM, ZGSM:  THE  GEOCENTRIC  SOLAR  MAGNETOSPHERIC  MAP20770 
COORDINATE  (EARTH  RADII)  MAP20780 


CALCULATE  THE  MAGNETIC  FIELD  AND  CURRENTS  DUE  TO  A 
CROSSTAIL  CURRENT  SHEET.  MULTIPLE  CURRENT  SEGMENTS  ARE 
JOINED  EDGE  TO  EDGE.  THE  CURRENT  STRENGTH  AND  POSITION 
AS  A  FUNCTION  OF  XGSM  ARE  ARBITRARY  AND  PROVIDED. 

A  YGSM  DEPENDENCE  IS  ALSO  INCLUDED. 


INPUT-  ISWIT:  COUNTER  USED  IN  SUBROUT.  ZPOS  MAP20750 

NSTEP:  NUMBER  OF  CURRENT  SEGMENTS  IN  TAIL  MAP20760 

XGSM, YGSM, ZGSM:  THE  GEOCENTRIC  SOLAR  MAGNETOSPHERIC  MAP20770 
COORDINATE  (EARTH  RADII)  MAP20780 

NOTE:  ALL  REFERENCES  TO  DISTANCE  ARE  MADE  IN  EARTHMAP20790 
RADII  IN  THE  GSM  COORDINATE  SYSTEM.  MAP20800 

DYC:  CHAR.  WIDTH  FOR  Y  DEPENDENCE  OF  BX  AND  BZ  MAP20810 

D:  HALF-WIDTH  OF  CURRENT  FILAMENTS  MAP20820 

XNST, ZNST:  XGSM  AND  ZGSM  POSITION  OF  CURRENT  SHEET  MAP20830 

BNST:  CURRENT  STRENGTH  AT  ANST, ZNST  MAP20840 

COLLAP:  FRACTION  OFT  AIL  FIELD  CURRENT  LIET  AT  MIDNIGHT  MAP20850 

=  1.  MEANS  NO  CHANGE,  ORIGINAL  TAIL  ONLY  MAP20860 

-  0.  MEANS  COMPLETE  COLLAPSE  AT  INNER  EDGE  MAP20870 

DELXC:  LENGTH  OF  INNER  TAIL  CURRENT  SHEET  (IN  X)  THAT  ISMAP20880 

DISRUPTED  MAP20890 

MAP20900 

OUTPUT-  BX,BY,BZ  MAGNETIC  FIELD  COMPONENTS  IN  GSM  (GAMMAS)  MAP20910 

MAP20920 

VARIABLES -XN,XF:  NEAR  AND  FAR  EDGES  OF  A  CURRENT  SEGMENT  MAP20930 

BN,BF:  VALUES  OF  B  AT  XN  AND  XF (REALLY  CURRENT  STRENGTH) MAP20940 
NSTEP:  NUMBER  OF  CURRENT  SEGMENTS  IN  TAIL  WITHIN  100  RE  MAP20950 
DELX:  STEP  SIZE  =  (XN-XF)  MAP20960 

FY:  VALUE  OF  Y-DEPENDENT  FUNCTION  (SEE  SUBROUT.  YYY  )  MAP20970 

FYP:  FIRST  DERIVATIVE  OF  Y-DEPENDENT  FUNCTION  ABOVE  MAP2098C 

DELB:  -(BN-BF)  MAP20990 

DD:  -  DELB/DELX  MAP21000 

SLOPE:  SLOPE  OF  A  SEGMENT  - (ZF-ZN) / (XF-XN)  MAP21010 

-  1.249E-10  MAP21020 

ALL  OTHER  VARIABLES  ARE  PRESENT  FOR  CONVENIENCE  AND  HAVEMAP21030 
NO  PARTICULAR  PHYSICAL  MEANINGS  IN  MOST  CASES.  MAP21040 


DISRUPTED 

OUTPUT-  BX,BY,BZ  MAGNETIC  FIELD  COMPONENTS  IN  GSM  (GAMMAS) 


mapint.for 


MAP21050 

SUBROUT.-  YYY:  RETURNS  YGSM  FUNCTIONAL  DEPENDENCE  AND  THE  MAP21060 

FIRST  DERIVATIVE  W.R.T.  YGSM  AT  A  GIVEN  YGSM  MAP21070 

MAP21080 

DIMENSION  XNST(50) ,ZNST(50) ,BNST(50)  MAP21090 

MAP21100 

BX  -  0. 

BY  -  0.  MAP21120 

BZ  -  0.  MAP21130 

MAP21140 

CALCULATE  CONTRIBUTIONS  FROM  NSTEP  CURRENT  SEGMENTS  TO  B-FIELDMAP21150 

MAP21160 

DO  10  N  =  1,  NSTEP  MAP21170 

MAP21180 

XN  -  XNST(N) 

XF  -  XNST(N+1)  MAP21200 

DELX  -  XN  -  XF  MAP21210 

MAP21220 

ZN  -  ZNST(N) 

ZF  -  ZNST(N+1)  MAP21240 

SLOPE  =  (ZF  -  ZN)/(XF  -  XN)  MAP21250 

MAP21260 

BN  -  BNST(N) 

BF  -  BNST(N+1)  MAP21280 

ADJUST  CURRENT  SIZE  AND  DIRECTION  FROM  ORIGINAL  MAP21290 

rRrTOR  below  gives  5  RE  COLLAPSE  "EDGE"  MAP21300 


XN  -  XNST(N) 

XF  -  XNST(N+1) 

DELX  -  XN  -  XF 

ZN  -  ZNST(N) 

ZF  -  ZNST(N+1) 

SLOPE  =  (ZF  -  ZN)/(XF  -  XN) 


BN  -  BNST(N)  ”^*^A  AAA 

BF  -  BNST(N+1)  MAP21280 

ADJUST  CURRENT  SIZE  AND  DIRECTION  FROM  ORIGINAL  MAP21290 

(0.1)  FACTOR  BELOW  GIVES  5  RE  COLLAPSE  "EDGE"  MAP21300 

CFN  -  .5* (TANH(0.1* (-XN+XNST(1)-DELXC) )-TANH(-0.1*DELXC)  -2.)  MAP21310 
CFF  »  .5*(TANH(0.1*(-XF+XNST(1)-DELXC))-TANH(-0.1*DELXC)  -  2.)  MAP21320 
NO  NEED  TO  CALCULATE  COLLAPSE  CURRENT  FOR  FAR  TAIL  MAP21330 

CUT  OUT  OF  LOOP  WHEN  CONTRIBUTION  IS  LESS  THAN  2  PERCENT  MAP21340 

THE  MAGNITUDE  OF  THE  REGULAR  CURRENT  OF  TAILC  MAP21350 

IF  (CFF. GT. (-0.02) )  THEN  MAP21360 


GOTO  11 
END  IF 


DELB 
DD  = 
QB  « 


(1.-  COLLAP) *BN*CFN 
(1.-  COLLAP) *BF*CFF 

-  BN  -  BF 
DELB/DELX 
BN  -  DD*XN 


MAP21330 

MAP21340 

MAP21350 

MAP21360 

MAP21370 

MAP21380 

MAP21390 

MAF21400 

MAP21410 

MAP21420 

MAP21430 

MAP21440 


MAP21450 

CONSTANTS  INVOLVED  IN  INTEGRATION:  A, B,C  ARE  COMMON  TO  BOTHMAP21460 
THE  BX  AND  BZ  EXPRESSIONS,  BY  =  0  MAP21470 

1.  +  SLOPE**2  MAP21480 


C 

C 

C 


C 

C 


C 


B  =  -2.*(XGSM  +  SLOPE* (ZGSM  -  ZN  +  SLOPE*XN) ) 

C  -  XGSM**2  +  (ZGSM  -  ZN  +  SLOPE*XN)**2  +  D**2 
BDX  -  -2. 

BDZ  -  -2.* SLOPE 
CDX  =  2.*XGSM 

CDZ  *  2.* (ZGSM  -  ZN  +  SLOPE*XN) 

TEST  FOR  PROPER  INTEGRAL  FORM,  ONLY  THE  FORM  FOR 
BEEN  INCLUDED.  NO  EXCEPTIONS  FOUND  TO  DATE 
ABC  *  4.*A*C  -  B**2 
SABC  =  SORT (ABC) 

IF  (ABC.LE.O.)  THEN 
GOTO  15 
END  IF 

SOME  CONSTANTS  FOR  BX  EXPRESSION 
CMX  *  -SLOPE*DD 

CNX  -SLOPE*QB  +  DD*  (SLOPE*XN  +  ZGSM  -  ZN) 

CPX  *  (SLOPE*XN  +  ZGSM  -  ZN) *QB 


MAP21490 
MAP21500 
MAP21510 
MAP21520 
MAP21530 
MAP21540 
MAP21550 
ABC  >  0  HAVEMAP21560 
MAP21570 
MAP21580 
MAP21590 
MAP21600 
MAP21610 
MAP21620 
MAP21630 
MAP21640 
MAP21650 
MAP21660 
MAP21670 
MAP21680 


DO  onoo  o  oo  oo  ono 


mapint.for 

CONSTANTS  FOR  BZ  EXPRESSION 


CMZ 

CNZ 

CPZ 


SOME 
■  DD 

-  BN  -  DD* (XN 
«  -XGSM*QB 


+  XGSM) 


SOME  COMMON  FACTORS  FOR  BOTH  BX  AND  BZ 


WLN  -  LOG( (A*XN**2+B*XN+C) / (A*XF**2+B*XF+C) ) 

WATAN  -  ATAN( (2*A*XN+B) /SABC)  -  ATAN ( (2*A*XF+B) /SABC) 

THE  BX  FUNCTION 

CLNX  -  (A*CNX  -  B*CMX) / (2.* (A**2) ) 

CTANX  =  (2.*A*{A*CPX-C*CMX)“B*(A*CNX-B*CMX))/((A**2)*SABC) 
BX  “  BX  +  (CMX*DELX) /A  +  CLNX*WLN  +  CTANX*WATAN 

THE  BZ  FUNCTION 

CLNZ  =  (A*CNZ  -  B*CMZ) / (2.* (A**2) ) 


(2.*A* (A*CPZ-C*CMZ) -B* (A*CNZ-B*CMZ) ) / ( (A**2) *SABC) 
+  (CMZ*DELX) /A  +  CLNZ*WLN  +  CTANZ*WATAN 


CTANZ  = 
BZ  »  BZ 

10  CONTINUE 

11  CONTINUE 


USING  SAME  Y  FUNCTION  AS  TAILC  SUBROUT.,  BUT  WITH  DIFFERENT 
DY  VALUE  (DYC  HERE) 

GET  YGSM  DEPENDENCE  AND  FIRST  DERIVATIVE 
CALL  YYY (YGSM, DYC, RADIUS, FY,FYP) 

NOW  INCLUDE  THE  YGSM  DEPENDENCE  IN  B-FIELD  AND  CURRENT 


BX  -  BX*FY 
BY  -  0. 

BZ  =  BZ*FY 
GOTO  20 

15 

CONTINUE 
WRITE (6, 99) 

99 

FORMAT (IHl, 
BX  -  0. 

BY  -  0. 

BZ  -  0. 

20 

CONTINUE 

RETURN 

END 

OUTPUT  SET  TO  ZERO' ) 


C**A******************  SEGMNT 

SUBROUTINE  SEGMNT ( I SWI T , TI LT , XNEAR, H JNEAR, H JFRAC , NSTEP , XNST , 


C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PURPOSE- 


INPUT- 


ZNST,BNST) 

FIND  THE  GSM  X  AND  Z  LOCATIONS  OF  THE 
USED  TO  BUILD  THE 
STRENGTH  FOR  EACH 
AWAY  FROM  EARTH. 


MAP21690 
MAP21700 
MAP21710 
MAP21720 
MAP21730 
MAP21740 
MAP21750 
MAP21760 
MAP21770 
MAP21780 
MAP21790 
MAP21800 
MAP21810 
MAP21820 
MAP21830 
MAP21840 
MAP21850 
MAP21860 
MAP21870 
MAP21880 
MAP21890 
MAP21900 
MAP21910 
MAP21920 
MAP21930 
MAP21940 
MAP21950 
MAP21960 
MAP21970 
MAP21980 
MAP21990 
MAP22000 
MAP22010 
MAP22020 
MAP22030 
MAP22040 
MAP22050 
MAP22060 
MAP22070 
MAP22080 
MAP220«''0 
MAP22100 
MAP22110 
MAP22120 
MAP22130 
MAP22140 
MAP22150 
MAP22160 

SEGMENT  BOUNDARIESMAP22170 


TAIL  CURRENT.  ALSO  ASSIGN  A  CURRENT 
POINT.  THE  INNER  EDGE  IS  ABS (XNEAR) 


ZPOS 


MAP22180 

MAP22190 

MAP22200 

MAP22210 

MAP22220 

MAP22230 


ISWIT;  COUNTER  USED  IN  SUBFDUT. 

TILT:  DIPOLE  TILT  IN  DEGREES 

XNEAR:  NEGATIVE  DISTANCE  TAILWARD, LOCATION  OF  INNER  EDGEMAP22240 
HJNEAR:  CURRENT  STRENGTH  AT  INNER  EDGE  MAP22250 

HJFRAC:  FRACTION  OF  HJNEAR  REMAINING  IN  FAR  TAIL  MAP22260 

NSTEP:  NUMBER  OF  SEGMENTS  USED  TO  BUILD  THE  TAIL  CURRENTMAP22270 
XNST,ZNST:  GSM  X  AND  Z  LOCATIONS  SEGMENT  BOUNDARIES  MAP22280 
BNST:  CURRENT  STRENGTH  AT  (XNST, ZNST)  MAP22290 

VARIABLES-FRAC:  FRACTION  OF  DESIRED  SEGMENT  LENGTH  MAP22300 

PI:  JUST  PI  MAP22310 

RTILT:  TILT  ANGLE  IN  RADIANS  MAP22320 


OUTPUT- 


mapint.for 


XNGSM, 2NGSM:  TEST  XGSM  AND  ZGSM  TO  FIND  INNER  EDGE 
SN:  DISTANCE  ALONG  SHEET  PLUS  INNEP  EDGE  DISTANCE 
DELS:  DESIRED  SEGMENT  LENGTH 

DIST:  TEST  DISTANCE  COMPARED  TO  DELS  OR  ABS (XNEAR) 


SUBROUT.-  ZPOS:  FINDS  ZGSM  LOCATION  OF  CURRENT  SHEET  AT  ANY  XGSM 
HJSIZE:  FINDS  CURRENT  STRENGTH  AT  POINT  ALONG  SHEET 

DIMENSION  XNST(50) ,ZNST(50) ,BNST(50) 

NSTEP  =16 

TAIL  IS  350  RE  LONG,  MADE  OF  16  SEGMENTS  OF  VARYING  LENGTHS 
FRAC  =  0.025 

SET  INNER  EDGE  POINT,  ABS (XNEAR)  IS  DISTANCE  FROM  EARTH 
IF  (TILT.NE.O.)  THEN 

STEP  ALONG  XGSM  AXIS  UNTIL  PROPER  DISTANCE  IS  FOUND 
PI  =  ACOS(-l.OO) 

RTILT  -  TILT*PI/180 
XNGSM  =0.0 
CONTINUE 

XNGSM  =  XNGSM  -  0.05 

CALL  ZPOS ( I SWIT, TILT, XNGSM, ZNGSM) 

DIST  =  SORT  (XNGSM* ’►2  +  ZNGSM**2) 

SEE  IF  INNER  EDGE  IS  AT  PROPER  DISTANCE  FROM  EARTH 
IF  (DIST. GE. ABS (XNEAR) )  THEN 
XNST(l)  =  XNGSM 
ZNST(l)  =  ZNGSM 
ELSE 
GOTO  2 
END  IF 
ELSE 

TILT  =  0 
XNST(l)  =  XNEAR 
ZNST(l)  =  0. 

END  IF 

SN  =  XNST(l) 

BNST(l)  =  HJSIZE (SN, XNST (1 ) ,HJNEAR,HJFRAC) 

GET  OTHER  SEGMENT  BOUNDARY  POINTS 
DO  10  N  =  1, NSTEP 
I  =  N  +  1 

GET  STEP  SIZE 
IF  (N.LE.8)  THEN 
DEij3  =  2,0 
ELSE 

IF  (N.LE.ll)  THEN 
DELS  =  5. 

ELSE 

IF  (N.LE.14)  THEN 
DELS  =  10. 

ELSE 

IF  (N.EQ.15)  THEN 
DELS  =  39. 

END  IF 
END  IF 
END  IF 
END  IF 

IF  (N.EQ. NSTEP)  THEN 
DELS  =  250. 

END  IF 

SN  «  SN  -  DELS 

BNST(I)  «  HJSIZE (SN, XNST (1) , HJNEAR, HJFRAC) 

IF  (TILT.NE.O.)  THEN 
:=•  (I.GT.2)  THEN 


MAP22330 

MAP22340 

MAP22350 

MAP22360 

MAP22370 

MAP22380 

MAP22390 

MAP22400 

MAP22410 

MAP22420 

MAP22430 

MAP22440 

MAP22450 

MAP22460 

MAP22470 

MAP22480 

MAP22490 

MAP22500 

MAP22510 

MAP22520 

MAP22530 

MAP22540 

MAP22550 

MAP22560 

MAP22570 

MAP22580 

MAP22590 

MAP22600 

MAP22610 

MAP22620 

MAP22630 

MAP22640 

MAP22650 

MAP22660 

MAP22670 

MAP22680 

MAP22690 

MAP22700 

MAP22710 

MAP22720 

MAP22730 

MAP22740 

MAP22750 

MAP22760 

MAP22770 

MAP22780 

MAP22790 

MAP22800 

MAP22810 

MAP22820 

MAP22830 

MAP22840 

MAP22850 

MAP22860 

MAP22870 

MAP22880 

MAP22890 

MAP22900 

MAP22910 

MAP22920 

MAP22930 

MAP22940 

MAP22950 

MAP22960 


mapint.for 


IF  (ZNST(I-l) .EQ.ZNST{I-2) )  THEN 

NOW  IN  FLAT  PART  OF  CURRENT  SHEET 


XNST(I) 
ZNSTd) 
GOTO  9 
END  IF 
END  IF 
XNST(I) 
CONTINUE 
XNST(I) 


XNST(I-l)  - 
ZNST (I-l) 


DELS 


XNST(I-l) 


XNSTd)  -  FRAC*DELS 
CALL  ZPOS  (ISWIT,  TILT,  XNST  d)  ,  ZNSTd)  ) 

DIST  -  SORT  ((XNSTd) -XNST  (1-1)  )**2+ (ZNST  (I) -ZNST  d-l))**2) 
IF  (DIST.GE.DELS)  THEN 

:  THEN  NEXT  SEGMENT  BOUNDARY  IS  FOUND 

GOTO  9 
ELSE 

:  ADD  ANOTHER  PIECE 

GOTO  5 
END  IF 
ELSE 

:  TILT  IS  ZERO 

XNSTd)  =  SN 
ZNST(I)  =  0. 

END  IF 

9  CONTINUE 

10  CONTINUE 
RETURN 
END 

;  ***********************************;  BVOIGT 

SUBROUTINE  BVOIGT (STAND, RADIUS, TILT, ALFA, CDIPOL, CIMF  BIMF,DIR, 


ISWIT,  X,Y,Z,  BX,BY,BZ) 


C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


MAP22970 

MAP22980 

MAP22990 

MAP23000 

MAP23010 

MAP23020 

MAP23030 

MAP23040 

MAP23050 

MAP23060 

MAP23070 

MAP23080 

MAP23090 

MAP23100 

MAP23110 

MAP23120 

MAP23130 

MAP23140 

MAP23150 

MAP23160 

MAP23170 

MAP23180 

MAP23190 

MAP23200 

MAP23210 

MAP23220 

MAP23230 

MAP23240 

MAP23250 

MAP23260 

MAP23270 

MAP23280 

KAP23290 

MAP23300 


PURPOSE-  COMPUTES  THREE  COMPONENTS  OF  THE  VECTOR  MAGNETIC  FIELD 
AT  ANY  POINT.  POINTS  OUTSIDE  OF  THE  MAGNETOPAUSE  WILL 
ONLY  RETURN  NONZERO  FIELDS  IF  INTERCONNECTION  IS  ALLOWEDMAP23310 
WITH  THE  IMF.  MAP23320 

MAP23330 

INPUT-  STAND,  THE  SUBSOLAR  STAND-OFF  DISTANCE  (IN  EARTH  RADII ) MAP23340 


STAND, 

RADIUS, 

TILT, 


TO 


RADIUS  OF  THE  MAGNETOTAIL  (IN  EARTH  RADII) 

DIPOLE  TILT  ANGLE  (IN  DEGREES) 

TILT>0  INDICATES  NORTHERN  HEMISPHERE  SUMMER 
ALFA,  PARAMETER  INDICATING  PLASMA  CONTENT  OF  TAIL, 

=  1.0  MEANS  VACUUM,  =0.0  MEANS  HARRIS  S  'EET 
CDIPOL,  FRACTION  OF  DIPOLE  FIELD  ALLOWED  TO  PENETRATE 
OUT  THROUGH  THE  MAGNETOPAUSE 
CIMF,  FRACTION  OF  THE  INTERPLANETARY  FIELD  ALLOWED 
PENETRATE  IN  THROUGH  THE  MAGNETOPAUSE 
BIMF,  MAGNITUDE  OF  THE  INTERPLANETARY  MAGNETIC  FIELD 
(IN  GAMMA) 

DIR,  DIRECTION  OF  IMF,  0  L 'GREES  IS  NORTH,  90 
IS  ANTI SUNWARD 

ISWIT,  INDICATES  THE  PROCEDURE  TO  FOLLOW  ON  THIS  CALL 
BFIELD  IS  CALLED  THREE  TIMES  WITH  ISWIT  =  1,2 
THEN  EITHER  3  OR  4 

*************ALTERED  so  >2  GIVES  GSM  RESULT  10/11/87 

-  1  GENERAL  COEFFICIENTS  ARE  FOUND  TO  REPRESENT  MAP23520 

THE  MAGNETIC  FIELD  WITH  LEGENDRE  AND  BESSEL  MAP23530 
SERIES  MAP23540 

-  2  CONSTANTS  SPECIFY  THE  CONFIGURAT.’ON  DESIRED  MAP23550 

ARE  CALCULATED  AND  STORED,  I.E.  TILT  MAP23560 

=  3  CALCULATES  FIELD  COMPONENTS,  INPUT  AND  OUTPUMAP23570 
ARE  IN  THE  SM  (SOLAR  MAGNETOSPHERIC)  SYSTEM  MAP23580 
«  4  SAME  AS  3  BUT  GSM  COORDINATES  ARE  USED  MAP23590 

X,Y,Z  CARTESIAN  COORDINATE  IN  EITHER  SM  OR  GSM  SYSTEM  MAP23600 


MAP23350 
MAP23360 
MAP23370 
MAP23380 
MAP23390 
MAP23400 
MAP23410 
MAP23420 
MAP23430 
MAP23440 
MAP23450 
DEGREESMAP23460 
MAP23470 
MAP23480 
MAP23490 
MAP23500 
MAP23510 


mapint.for 


9 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


OUTPUT- 


BX,BY,BZ  MAGNETIC  FIELD  VECTOR  IN  CARTESIAN  SYSTEM 

ACCORDING  TO  CHOICE  1SWIT=3  OR  4.  (IN  GAMMA) 


VARIABLES-  NDIM 

NELE 

BEX 
XD,  YD,  ZD 

HXD,HYD,HZD 
XM,YM, ZM 


HXM, HYM, HZM 
SNPS,CSPS 


NUMBER  OF  GRID  POINTS  TO  BE  USED  FOR  INTEGRATION 
TO  OBTAIN  SERIES  COEFFICIENTS 

NUMBER  OF  ITERATIONS  TO  BE  MADE  BETWEEN  SPHERICAL 
AND  CYLINDRICAL  COEFFICIENT  CALCULATIONS. 

DISTANCE  BETWEEN  SPHERE  CENTER  AND  EARTH 
CARTESIAN  COORDINATES  IN  DIPOLE  SYSTEM,  XD  IS 
PERPEND.  TO  DIPOLE  MOMENT  POINTING  ANTIS'.TNWARD 
MAGNETIC  FIELD  COMPONENTS  IN  DIPOLE  SYSTEM 
EARTH  CENTERED  CARTESIAN  SYSTEM,  XM  POINTS  ANTI- 
SUNWARD,  PARALLEL  TO  THE  TAIL  AXIS  (CALLED  THE  M 
SYSTEM) 

MAGNETIC  FIELD  COMPONENTS  ON  M  SYSTEM 
SIN  AND  COS  OF  THE  DIPOLE  TILT  ANGLE 


REFERENCES- 


REFl:  VOIGT, G.-H.,  A  MATHEMATICAL  MAGNETOSPHERIC 

FIELD  MODEL  WITH  INDEPENDENT  PHYSICAL  PARAMETERS,  PLANETARY 
AND  SPACE  SCIENCE,  VOL.  29,  1-20,1981 

REF2:  ABRAMOWITZ  AND  STE3UN, EDS . ,  HANDBOOK  OF 

MATHEMATICAL  FUNCTIONS,  U.S.  NATIONAL  BUREAU  OF  STANDARDS, 
DOVER,  NEW  YORK,  (1965) 

REF3:  JAHNKE-EMDE-LOSCH,  TABLES  OF  HIGHER 

FUNCTIONS,  6TH  EDITION (REVISED) ,  NEW  YORK,  (1960) 


REF4: 

COORDINATE  SYSTEMS- 


VOIGT  PH.D.  THESIS 


GSM 


SM 


M 


GEOCENTRIC  SOLAR  MAGNETOSPHERIC  -  EARTH  CENTERED 
XGSM  :  FROM  EARTH  TO  SUN 

YGSM  :  PERPENDICULAR  TO  EARTH'S  DIPOLE,  POINTING 
TOWARDS  DUSK 

ZGSM  :  SAME  SENSE  AS  NORTHERN  MAGNETIC  POLE 
DIPOLE  CONTAINED  WITHIN  X-Z  PLANE 

SOLAR  MAGNETIC  -  EARTH  CENTERED 

XSM  :  TOWARD  SUN  BUT  NOT  DIRECTLY  UNLESS  TILT  ZERO 
YSM  -  YGSM 

ZSM  :  PARALLEL  TO  NORTH  MAGNETIC  POLE 
THE  M  SYSTEM  (XM,YM, ZM)  -  EARTH  CENTERED 


XM 

YM 

ZM 


-XGSM 

-YGSM 

ZGSM 


THE  V  SYSTEM  (XV,YV,ZV)  -  SPHERE  CENTERED 


XV 

YV 

ZV 


ZGSM 

YGSM 

-XGSM 


B  WHERE  B  =  (TAIL  RADIUS )- (STAND-OFF) 
THE  D  SYSTEM  (XD,YD,ZD)  -  EARTH  CENTERED 


MAP23610 

MAP23620 

MAP23630 

MAP??f40 

MAP23650 

MAP23660 

MAP23670 

MAP23680 

MAP23690 

MAP23700 

MAP23710 

MAP23720 

MAP23730 

MAP23740 

MAP23750 

MAP23760 

MAP23770 

MAP23780 

MAP23790 

MAP23800 

MAP23810 

MAP23820 

MAP23830 

MAP23840 

MAP23850 

MAP23860 

MAP23870 

MAP23880 

MAP23890 

MAP23900 

MAP23910 

MAP23920 

MAP23930 

MAP23940 

MAP23950 

MAP23960 

MAP23970 

MAP23980 

MAP23990 

MAP24000 

MAP24010 

MAP24020 

MAP24030 

MAP24040 

MAP24050 

MAP24060 

MAP24070 

MAP24080 

MAP24090 

MAP24100 

MAP24110 

MAP24120 

MAP24130 

MAP24140 

MAP24150 

MAP24160 

MAP24170 

MAP24180 

MAP24190 

MAP24200 

MAP24210 

MAP24220 

MAP24230 

MAP24240 


mapint.for 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


c 

c 

c 


XD  =  -XSM 

YD  “  -YSM  »  -YGSM 

ZD  =  ZSM 

SPHERICAL  SYSTEM  (R, THETA, PHI)  -  SPHERE  CENTERED 

R  :  DISTANCE  FROM  ORIGIN  {XV, YV, ZV) = (O, O, 0) 

THETA  :  ANGLE  BETWEEN  ZV  AND  VECTOR  R 
PHI  :  ANGLE  BETWEEN  XV  AND  COMPONENT  OF  VECTOR  R 
IN  THE  XV-YV  PLANE 

CYLINDRICAL  SYSTEM  (RHO,PHI,Z)  -  SPHERE  CENTERED 

RHO  :  RADIAL  DISTANCE  FROM  ZV  AXIS 
PHI  :  ANGLE  BETWEEN  XV-ZV  PLANE  AND  VECTOR  RHO 
(SAME  AS  PHI  OF  SPHERICAL) 

Z  =  ZV 

COMMON  /BLOCKl/  BEX, R, Q, PI, PSI 

COMMON  /BL0CK3/  HO,  ALFB,  N 

COMMON  /BLOCKS/  CSPH, SNPH, QCS, QSN, CSPS, SNPS 

COMMON  /BL0CK6/  CT,  ST 

COMMON  /FIMF/  HIMF,  CD,  Cl,  XI 

ALFB  =  ALFA 

R  =  RADIUS 
CD  =  CDIPOL 
Cl  =  CIMF 
HIMF  •=  BIMF 
XI  -  DIR 


IF  (ISWIT.EQ.l)  THEN 

GET  COEFFICIENTS  FOR  SPHERICAL  AND  BESSEL  HARMONICS 
BEX  =  RADIUS  -  STAND 
NDIM  -  101 
NELE  »  4 

CALL  COEFFS (NDIM, NELE) 

END  IF 


C 

IF  {ISWIT.EQ.2)  THEN 

C  SET  CONSTANTS,  SPECIFY  TILT  WHICH  WAS  PRESET  IN  COEFFS 

C  NOTE  THAT  SIGN  OF  TILT  ANGLE  IS  BEING  SWITCH 

TI  -  -  TILT 
CALL  CONST (TI) 

END  IF 


C 

C 

CCC 

C 

C 

C 

CCC 

CCC 

CCC 

c 

c 

CCC 

C 

C 

CCC 

c 

c 


SM  COORDINATE  OPTION  CUTOFF  FOR  NOW  EVERYTHING  IN  GSM 
IF  (ISWIT.EQ.3)  THEN 

GET  BFIELD  AT  POINT  USING  SM  COORDINATE  SYSTEM 

TRANSFORM  SM  TO  DIPOLE  SYSTEM,  XD  IS  PERPENDICULAR 
TO  DIPOLE  MOMENT  POINTING  OPPOSITE  XSM 

XD  -  -  X 
YD  -  -  Y 
ZD  *  +  Z 

TRANSFORM  DIPOLE  TO  M  SYSTEM,  XM  ANTISOLAR 
CALL  TRANS4 (XD,YD,ZD,XM,YM,ZM) 

GET  FIELD  COMPONENTS  AT  XM,YM, ZM 
CALL  BTOTAL(XM,YM, ZM,HXM, HYM, HZM) 

TRANSFORM  FIELD  COMPONENTS  BACK  TO  DIPOLE  SYSTEM 


MAP24250 

MAP24260 

MAP24270 

MAP24280 

MAP24290 

MAP24300 

MAP24310 

MAP24320 

MAP24330 

MAP24340 

MAP24350 

MAP24360 

MAP24370 

MAP24380 

MAP24390 

MAP24400 

MAP24410 

MAP24420 

MAP24430 

MAP24440 

MAP24450 

MAP24460 

MAP24470 

MAP24480 

MAP24490 

MAP24500 

MAP24510 

MAP24520 

MAP24530 

MAP24540 

MAP24550 

MAP24560 

MAP24570 

MAP24580 

MAP24590 

MAP24600 

MAP24610 

MAP24620 

MAP24630 

MAP24640 

MAP24650 

MAP24660 

MAP24670 

MAP24680 

MAP24690 

MAP24700 

MAP24710 

MAP24720 

MAP24730 

MAP24740 

MAP24750 

MAP24760 

MAP24770 

MAP24780 

MAP24790 

MAP24800 

MAP24810 

MAP24820 

MAP24830 

MAP24840 

MAP24850 

MAP24860 

MAP24870 

MAP24880 


1 

mapint.for 

1 

CCC 

HXD  = 

HXM*CSPS  -  HZM*SNPS 

MAP24890 

ccc 

HYD  = 

HYM 

MAP24900 

CCC 

HZD  = 

HXM*SNPS  +  HZM*CSPS 

MAP24910 

c 

MAP24920 

c 

OUTPUT  IN  SM  COORDINATES (GAMMAS) 

MAP24930 

ccc 

BX  « 

-  HXD 

MAP24940 

ccc 

BY  « 

-  HYD 

MAP24950 

ccc 

BZ  = 

+  HZD 

MAP24960 

c 

MAP24970 

ccc 

END  IF 

MAP24980 

c 

MAP24990 

c 

ALL  CALLS  WITH  ISWIT  >  2  GIVE  POINT  RESULT  IN  GSM  COORDINATES 

MAP25000 

IF  (ISWIT 

.GT.2)  THEN 

MAP25010 

c 

GET  BFIELD  AT  POINT  USING  GSM  COORDINATE  SYSTEM 

MAP25020 

XM  - 

-  X 

MAP25030 

YM  - 

-  Y 

MAP25040 

ZM  «= 

+  Z 

MAP25050 

GET  BFIELD  COMPONENTS  AT  XM,YM, ZM 
CALL  BTOTAL(XM,YM, ZM, HXM, HYM,H2M) 

OUTPUT  IN  GSM  COORDINATES (GAMMAS) 

BX  =  -  HXM 
BY  »  -  HYM 
BZ  =  +  HZM 

END  IF 
RETURN 
END 

>*********************************.  COEFFS 
SUBROUTINE  COEFFS (NDIM, NELE) 

PURPOSE-  CALCULATE  COEFFICIENTS 

INPUT-  NDIM,  NUMBER  OF  GRID  POINTS  FOR  NUMERICAL  INTEGRATION 
NELE,  NUMBER  OF  INTERATIONS  TO  OBTAIN  COEFFICIENTS 

FILL  COMMON  BLOCK  SITES  WITH  BESSEL  ROOTS  AND  VALUES 

CALL  ZERO 

DO  10  KSA  =  1,  NELE 

GET  COEFFICIENTS  OF  LEGENDRE  POLYNOMIALS 
CALL  SPHRCO (NDIM, KSA) 

GET  COEFFICIENTS  OF  BESSEL  SERIES 
CALL  TAILCO(NDIM) 

)  CONTINUE 


RETURN 

END 

SUBROUTINE  CONST (TI) 


CONST 


PURPOSE- 
INPUT  - 


OUTPUT- 


VARIABLES  - 


PROVIDE  CONSTANTS  (TO  COMMON  BLOCKS) 

TI,  DIPOLE  TILT  ANGLE  IN  DEGREES 

TI>0  INDICATES  NORTHERN  HEMISPHERE  WINTER 
R,  RADIUS  OF  TAIL  (FROM  BLOCK  1)  IN  EARTH  RADII 
Q,  RATIO  OF  DIPOLE  MOMENT/ (RADIUS**3)  IN  GAMMA 
PSI,  DIPOLE  TILT  ANGLE  IN  RADIANS 
PI,  RADIAN  EQUIVALENT  OF  180  DEGREES 
SNPS  AND  CSPS,  SIN  AND  COS  OF  PSI 
DM,  DIPOLE  MOMENT  IN  GAMMA* (METERS* *3) 

RE,  EARTH  RADIUS,  METERS 


MAP25060 

MAP25070 

MAP25080 

MAP25090 

MAP25100 

MAP25110 

MAP25120 

MAP25130 

MAP25140 

MAP25150 

MAP25160 

MAP25170 

MAP25180 

MAP25190 

MAP25200 

MAP25210 

MAP25220 

MAP25230 

:4AP25240 

MAP25250 

MAP25260 

MAP25270 

MAP25280 

MAP25290 

MAP25300 

MAP25310 

MAP25320 

MAP25330 

MAP25340 

MAP25350 

MAP25360 

MAP25370 

MAP25380 

MAP25390 

MAP25400 

MAP25410 

MAP25420 

MAP25430 

MAP25440 

MAP25450 

MAP25460 

MAP25470 

MAP25480 

MAP25490 

MAP25500 

MAP25510 

MAP25520 


CCWMON  /BLOCKl/  BEX, R, Q, PI ,  PSI 


oo  o  o  r.  no  non 


mapint.for 


COMMON  /BLOCKS/  CSPH, SNPH, QCS, QSN, CSPS, SNPS 
COMMON  /BLOCKS/  CT,  ST 
C 

PI  =  ACOS(-l.OO) 

C 

DM  -  7.951E+24 
RE  -  6.37104E+06 
ZA  -  R*RE 
Q  -DM/(ZA**3) 

C 

PSI  -  (PI*TI) /180.0 
CSPS  -  COS (PSI) 

SNPS  -  SIN{PSI) 

C 


RETURN 

END 

C  ***********************************;  BTOTAL 
SUBROUTINE  BTOTAL (XM, YM, ZM, HXM, HYM, HZM) 

C 

C  PURPOSE-  GET  FIELD  COMPONENTS  USING  PREDETERMINED  COEFFICIENTS 

C  INPUT-  XM,YM, ZM  M  COORDINATES 

C  OUTPUT-  HXM, HYM, HZM  FIELD  COMPONENTS  IN  M  SYSTEM  IN  GAMMAS 

C 

COMMON  /BLOCKl/  BEX, R, Q, PI , PSI 

COMMON  /BLOCK5/CSPH, SNPH, QCS, QSN, CSPS, SNPS 

COMMON  /BLOCKS/  CT,  ST 


TRANSFORM  M  TO  SPHERICAL  COORDINATES  RR,T,PHI 
TWO  STEP  TRANSFORM  BECAUSE  ZV  IS  NEEDED  BELOW  IN  'IF' 
CALL  TRANS5 (XM,YM, ZM,XV, YV, ZV,D1,D2,D3) 

CALL  TRANS3(XV,YV,ZV,RR,T,PHI) 

IF(ZV.LT.O.O)  THEN 

GET  FIELD  FROM  DAYSIDE  OF  SPHERE  ZV<0 
CALL  DAYTOT(RR,T,PHI,HR,HT,HP) 

TRANSFORM  TO  CARTESIAN  ZV  DOWN  TAIL 
CALL  BTRANl (HR, HT,HP,HXV,HYV,HZV) 

ELSE 

GET  FIELD  FROM  NIGHTSIDE  OF  SPHERE  ZV>0 
RRZ  -  SQRT(XV*XV  +  YV*YV) 

CALL  TAILTO(RRZ,PHI,ZV,HR,HP,HZ) 

TRANSFORM  TO  CARTESIAN  ZV  DOWN  TAIL 
CALL  BTRAN2 (HR,HZ,HP,HXV,HYV,HZV) 

END  IF 

TRANSFORM  BACK  TO  M  SYSTEM  FOR  OUTPUT 
HXM  =  +  HZV 
HYM  -  -  HYV 
HZM  -  +  HXV 
C 

RETURN 

END 

C  ***********************************;  TRANS4 
SUBROUTINE  TRANS4 (XD, YD, ZD, XM, YM, ZM) 

C 

C  PURPOSE-  TRANSFORM  DIPOLE  TO  M  COORDINATES 

C  INPUT-  XD,YD,ZD  DIPOLE  COORDINATES,  ZD  NORTH,  XD  TAILWARD 

C  OUTPUT-  XM,YM, ZM  M  COORDNATES,  XM  IS  ANTISUNWARD 

C  VARIABLES-  SNPS  AND  CSPS,  SIN  AND  COS  OF  DIPOLE  TILT  ANGLE 

C 

COMMON  /BLOCK5/CSPH, SNPH, QCS, QSN, CSPS, SNPS 
C 

XM  -  ZD*SNPS  +  XD*CSPS 
YM  -  YD 


MAP25530 

MAP25540 

MAP25550 

MAP25560 

MAP25570 

MAP25580 

MAP25590 

MAP25600 

MAP25610 

MAP25620 

MAP25630 

MAP25640 

MAP25650 

MAP25660 

MAP25670 

MAP25680 

MAP25690 

MAP25700 

MAP25710 

MAP25720 

MAP25730 

MAP25740 

MAP25750 

MAP25760 

MAP25770 

MAP25780 

MAP25790 

MAP25800 

MAP25810 

MAP25820 

MAP25830 

MAP25840 

MAP25850 

MAP25860 

MAP25870 

MAP25880 

MAP25890 

MAP25900 

MAP25910 

MAP25920 

MAP25930 

MAP25940 

MAP25950 

MAP25960 

MAP25970 

MAP25980 

MAP25990 

MAP26000 

MAP26010 

MAP26020 

MAP26030 

MAP26040 

MAP26050 

MAP26060 

MAP26070 

MAP26080 

MAP26090 

MAP26100 

MAP26110 

MAP26120 

MAP26130 

MAP26140 

MAP261S0 

MAP26160 


O  f)  o  o  o  o  o 


mapint.for 


ZD*CSPS  -  XD*SNPS 


RETURN 

END 

SUBROUTINE  SPHRCO (NDIM, KSA) 


SPHRCO 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 


PURPOSE- 

INPUT- 


OUTPUT- 


VARIABLES- 


CALCULATE  COEFFICIENTS  FOR  LEGENDRE  POLYNOMIALS 
NDIM,  NUMBER  OF  GRID  POINTS  FOR  NUMERICAL  INTEGRATION 

GRID  POINTS  ARE  ON  SPHERE  SURFACE  FROM  THETA  0  TO 
180  AND  PHI=0,  THETA=0  POINTS  DOWN  TAIL 
KSA,  ITERATION  LEVEL 

G1,G0,  COEFFICIENTS  FOR  TILT  0  AND  90  DEGREES  RESPECT. 
CONTAIN  ALL  EXCEPT  ANGULAR  AND  LEGENDRE  FUNCTIONS 
SEE  EQ.  5.2.3  REF4  FOR  GENERAL  EXPRESSIONS 

Q,  RATIO  OF  DIPOLE  MOMENT /RADIUS* *3 

R,  RADIUS  OF  TAIL  AND  SPHERE 
B,  =  R  -  STANDOFF  DISTANCE 

N,  ORDER  OF  LEGENDRE  POLYNOMIAL 
TI,  DIPOLE  TILT  ANGLE 
HS,  GRID  SIZE 

Y1,Y0,  INTEGRAND  FOR  0  AND  90  DEGREE  CASES 

Z1,Z0,  RESULT  OF  INTEGRALS  FOR  0  AND  90  DEGREE  CASES 

COMMON  /BLOCKS/  X (1001 ), Y1 (1001 ), YO (1001) , Z1 (1001 ), ZO (1001 ) ,  HS 
COMMON  /CHABLO/  Gl(20),  GO (20) 

COMMON  /BLOCKl/  B,R,Q,PI,PSI 


IF(KSA.EQ.l)  THEN 

COEFFICIENTS  ARE  ANALYTIC,  5.11  AND  5.12  REFl 
TI  -  0.0 


CALL  CONST (TI) 
Gl(l)  =  -  2.  *  Q 
G0(1)  =  -  2.  *  Q 
EP  -  +1.0 
RRP  »  1.0 
RP  -  B/R 

DO  1  N  =  2,  20 
EP  =  -EP 
RRP  -  RRP  *  RP 
G1  (N)  =  -  Q  *  EP 
G0(N)  =  -  Q  *  EP 
CONTINUE 


*  FLOAT (N+1)  *  RRP 

*  FLOAT (N* (N+1) )  *  RRP 


ELSE 


NUMERICAL  INTEGRATION  REQUIRED  FOR  KSA>1 

GET  RADIAL  COMPONENT  OF  DIPOLE  PLUS  TAIL  SOLUTION 
ON  GRID 

CALL  BRDIP (NDIM) 

DO  3  N  “  1,  20 

FORM  INTEGRANDS  Y1  AND  YO 
CALL  FUN1(N,NDIM) 

INTEGRATE,  RESULTS  Z1  AND  ZO 
CALL  INTEGR(HS,Y1, Z1,NDIM) 

CALL  INTEGR(HS,Y0, Z0,NDIM) 

ZFE  =  FLOAT (2*N+1) 

FN  =  FLOAT (N) 

FORM  COEFFICIENTS  5.2 
0.5  *  ZFE  /  (FN*(FN+1 
0.5  *  ZFE  *  ZO(NDIM) 


G1  (N) 
GO  (N) 
CONTINUE 
END  IF 


3  REF4 

))  *  Z1 (NDIM) 


MAP26170 

MAP26180 

MAP26190 

MAP26200 

MAP26210 

MAP26220 

MAP26230 

MAP26240 

MAP26250 

MAP26260 

MAP26270 

MAP26280 

MAP26290 

MAP26300 

MAP26310 

MAP26320 

MAP26330 

MAP26340 

MAP26350 

MAP26360 

MAP26370 

MAP26380 

MAP26390 

MAP26400 

MAP26410 

MAP26420 

MAP26430 

MAP26440 

MAP26450 

MAP26460 

MAP26470 

MAP26480 

MAP26490 

MAP26500 

MAP26510 

MAP26520 

MAP26530 

MAP26540 

MAP26550 

MAP26560 

MAP26570 

MAP26580 

MAP26590 

MAP26600 

MAP26610 

MAP26620 

MAP26630 

MAP26640 

MAP26650 

MAP26660 

MAP26670 

MAP26680 

MAP26690 

MAP26700 

MAP26710 

MAP26720 

MAP26730 

MAP26740 

MAP26750 

MAP26760 

MAP26770 

MAP26780 

MAP26790 

MAP26800 


oooooo  ooooooo 


mapint.for 


RETURN 

END 

ir*******************************.  DAYTOT 
SUBROUTINE  DAYTOT (RR, T, PHI , HR, HT, HP) 


PURPOSE-  CALCULATE  TOTAL  FIELD  OF  DAYSIDE  HALF  OF  SPHERE  ZV<0 
INPUT-  RR,T,PHI  SPHERICAL  COORDINATES  OF  INTEREST 
OUTPUT-  HR, HT,HP  FIELD  COMPONENTS  IN  SPHERICAL  SYSTEM 
VARIABLES-  CDIPOL,  FRAC.  OF  DIPOLE  PENETRATING  OUT  OF  MAGNETOPAUSE 
CIMF,  FRAC.  OF  IMF  PENETRATING  INTO  MAGNETOPAUSE 

COMMON  /BLOCKl/  B,  R,  Q,  PI,  PSI 
COMMON  /FIMF/  HIMF,  CDIPOL,  CIMF,  XI 

CD  =  (1.-  CDIPOL) 

CF  -  (1.-  CIMF) 

IF(RR.LE.R)  THEN 

GET  FIELD  INSIDE  SPHERE 
DIPOLE  FIELD 

CALL  BDIP  (RR, HR1,HT1,HP1) 

CHAPMAN-FERRARO  DUE  TO  DIPOLE 
CALL  CFDSPH(RR,HR2,HT2,HP2) 

TAIL  SOLUTION,  DAYSIDE  INFLUENCE 
CALL  BTASPH  (RR, HR3, HT3,  HP3) 

IMF  FIELD 

CALL  BIMF  (HIMF,XI,D1,D2,D3,D4,  HR5,HT5,HP5,  D5,D6,D7) 

EQ.  3.22  INTERNAL  FIELD  REFl 


MAP26810 

MAP26820 

MAP26830 

MAP26840 

MAP26850 

MAP26860 

MAP26870 

MAP26880 

MAP26890 

MAP26900 

MAP26910 

MAP26920 

MAP26930 

MAP26940 

MAP26950 

MAP26960 

MAP26970 

MAP26980 

MAP26990 

MAP27000 

MAP27010 

MAP27020 

MAP27030 

MAP27040 

MAP27050 

MAP27060 

MAP27070 

MAP27080 

MAP27090 


HR  “ 

HRl 

+ 

CD  * 

(HR2 

+ 

HR3) 

+ 

CIMF  * 

HRS 

MAP27100 

HT  - 

HTl 

+ 

CD  * 

(HT2 

+ 

HT3) 

+ 

CIMF  * 

HT5 

MAP27110 

HP  - 

HPl 

+ 

CD  * 

(HP2 

+ 

HP3) 

+ 

CIMF  * 

HPS 

MAP27120 

GET  FIELD  OUTSIDE  SPHERE 
DIPOLE  FIELD 

CALL  BDIP  (RR,HR1,HT1,HP1) 

CHAPMAN-FERRARO  DUE  TO  IMF 
CALL  CFISPH(RR,HR2,HT2,HP2) 

IMF  FIELD 

CALL  BIMF  {HIMF,XI,D1,D2,D3,D4,  HR5,HT5,HP5,  D5,D6,D7) 

EQ.  3.23  EXTERNAL  FIELD  REFl 
HR  =  HRS  +  CF  *  HR2  +  CDIPOL  *  HRl 

HT  -  HT5  +  CF  *  HT2  +  CDIPOL  *  HTl 

HP  -  HP5  +  CF  *  HP2  +  CDIPOL  *  HPl 

END  IF 
RETURN 
END 

C  ***********************************.  TAILTO 
SUBROUTINE  TAILTO (RR, PHI, Z, HR,  HP,  HZ) 

C 

C  PURPOSE-  CUVLCULATE  TOTAL  FIELD  OF  CYLINDER  PORTION  FOR  ZV>0 

C  INPUT-  RR, PHI,Z,  CYLINDRICAL  COORDINATES 

C  OUTPUT-  HR, HP, HZ,  FIELD  COMPONENTS  IN  CYLINDRICAL  SYSTEM 

C  VARIABLES-  CDIPOL,  FRAC.  OF  DIPOLE  PENETRATING  OUT  OF  MAGNETOPAUSE 

C  CIMF,  FRAC.  OF  IMF  PENETRATING  IN  THROUGH  MAGNETOPAUSE 

C  SNPH,CSPH,  SIN  AND  COS  OF  PHI 

C 

COMMON  /BLOCKl/  BEX, R, Q, PI, PSI 
COMMON  /BLOCKS/  CSPH, SNPH, QCS, QSN, CSPS, SNPS 
COMMON  /BLOCKS/  CT,  ST 
COMMON  /FIMF/  HIMF,  CDIPOL,  CIMF,  XI 
C 

CD  -  (1.-  CDIPOL) 


MAP27130 

MAP27140 

MAP271S0 

MAP27160 

MAP27170 

MAP27180 

MAP27190 

MAP27200 

MAP27210 

MAP27220 


MAP27260 

MAP27270 

MAP27280 

MAP27290 

MAP27300 

MAP27310 

MAP27320 

MAP27330 

MAP27340 

MAP273S0 

MAP27360 

MAP27370 

MAP27380 

MAP27390 

MAP27400 

MAP27410 

MAP27420 

MAP27430 

MAP27440 


mapinffor 


CF  »  (1.-  CIMF)  MAP27450 

MAP27460 

IF(RR.LE,R)  THEN  MAP27470 

GET  FIELD  INSIDE  CYLINDER  MAP27480 

RRR  -  S2RT(RR*RR  +  Z*Z)  MAP27490 

DIPOLE  FIELD  MAP27500 

CALL  BDIP (RRR,HR1,HT1,HP1)  MAP27510 

TRANSFORM  SPHERICAL  TO  CARTESIAN,  HZV  DOWN  TAIL  MAP27520 

CALL  BTRANl (HR1,HT1,HP1,  HXV,HYV,HZV)  MAP27530 

TRANSFORM  CARTE IAN  TO  CYLINDRICAL  MAP27540 

HRl  -  HXV  *  CSPH  +  HYV  *  SNPH  MAP27550 

HPl  -  HYV  *  CSPH  -  HXV  *  SNPH  MAP27560 

HZl  -  HZV  MAP27570 

TOTAL  TAIL  FIELD  SOLUTION  MAP27580 

CALL  BTATA(Z,RR,HR2,HZ2,HP2)  MAP27590 

CHAPMAN-FERRARO  =  TOTAL  FIELD  -  DIPOLE  FIELD  MAP27600 

HR2  -  HR2  -  HRl  MAP27610 

HP2  -  HP2  -  HPl  MAP27620 

H22  -  HZ2  -  HZl  MAP27630 

GET  IMF  FIELD  MAP27640 

CALL  BIMF  (HIMF,XI,  D1,D2,D3,D4,D5,D6,D7,  HR5,HZ5,HP5)  MAP27650 

SUM  OF  INTERNAL  FIELDS,  3.22  REFl  MAP27660 


HR 

-  HRl 

+ 

CD 

*  HR2 

+ 

CIMF 

*  HRS 

MAP27670 

HZ 

=  HZl 

+ 

CD 

*  HZ2 

+ 

CIMF 

*  HZS 

MAP27680 

HP 

-  HPl 

+ 

CD 

*  HP2 

+ 

CIMF 

*  HPS 

MAP27690 

3  MAP27700 

GET  FIELD  OUTSIDE  OF  CYLINDER  MAP27710 

RRR  -  SQRT(RR*RR  +  Z*2)  MAP27720 

DIPOLE  FIELD  MAP27730 

CALL  BDIP (RRR,HR1,HT1,HP1)  MAP27740 

TRANSFORM  SPHERICAL  TO  CARTESIAN,  HZV  DOWN  TAIL  MAP27750 

CALL  BTRANl (HRl, HTl, HPl,  HXV, HYV, HZV)  MAP27760 

TRANSFORM  CARTESIAN  TO  CYLINDRICAL  MAP27770 

HRl  =  HXV  *  CSPH  +  HYV  *  SNPH  MAP27780 

HPl  =  HYV  *  CSPH  -  HXV  *  SNPH  MAP27790 

HZl  -  HZV  MAP27800 

CHAPMAN-FERRARO  DUE  TO  IMF  MAP27810 

CALL  CFITA(RR,HR2,HZ2,HP2)  MAP27820 

IMF  FIELD  MAP27830 

CALL  BIMF  (HIMF,XI,  D1,D2,D3,D4,D5,D6,D7,  HR5,HZ5,HP5)  MAP27840 

SUM  OF  EXTERNAL  FIELDS  USING  3.23  REFl  MAP27850 


HR 

-  HRS 

+ 

CF  * 

HR2 

+ 

CDIPOL  * 

HRl 

MAP27860 

HZ 

■=  HZS 

+ 

CF  * 

HZ2 

+ 

CDIPOL  * 

HZl 

MAP27870 

HP 

=  HPS 

+ 

CF  * 

HP2 

+ 

CDIPOL  * 

HPl 

MAP27880 

END  IF 
RETURN 
END 

***********************************.  BTRANl 
SUBROUTINE  BTRANl (HRV, HTV, HPV, HXV, HYV, HZV) 

PURPOSE-  CHANGES  FIELD  COMPONENTS  FROM  SPHERICAL  TO  CARTESIAN 
HZV  POINTS  DOWN  TAIL  AXIS,  -0  TO  SPHERE  CENTER 
INPUT-  HRV, HTV, HPV,  SPHERICAL  COMPONENTS 

OUTPUT-  HXV, HYV, HZV,  CARTESIAN  COMPONENTS 

VARIABLES-  ST,CT,  SIN  AND  COS  OF  THETA 
CP,SP,  COS  AND  SIN  OF  PHI 


COMMON  /BLOCKS/  CP, SP, QCS, QSN, CSPS, SNPS 
COMMON  /BLOCK6/  CT,  ST 

HXV  -  HRV*ST*CP  +  HTV*CT*CP  -  HPV*SP 
HYV  -  HRV*ST*SP  +  HTV*CT*SP  +  HPV*CP 
HZV  -  HRV*CT  -  HTV* ST 


MAP27890 

MAP27900 

MAP27910 

MAP27920 

MAP27930 

MAP27940 

MAP27950 

MAP27960 

MAP27970 

MAP27980 

MAP27990 

MAP28000 

MAP28010 

MAP28020 

MAP28030 

MAP23040 

MAP28050 

MAP28060 

MAP28070 

MAP28080 


mapint.for 


43 


RETURN 

END 

t4r^i^*A4r'*'*****4r***ik4c****'Ar4r**:fr*4r4r4r*4r< 

SUBROUTINE  TAILCO(NDIM) 


TAILCO 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 


C 

C 


PURPOSE-  NUMERICAL  CALCULATION  OF  FOURIER-BESSEL  COEFFICIENTS 
INPUT-  NDIM,  NUMBER  OF  GRID  POINTS  ALONG  CYLINDER  CAP  AT 
THETA=90  DEGREES  FOR  INTEGRATION 
OUTPUT-  AX,BX  FOURIER-BESSEL  COEFFICIENTS  WITH  MODIFICATIONS 
TO  BE  USEFUL  IN  FINAL  EXPRESSION  6.4  REFl 
VARIABLES-  BE, BO  BESSEL  FUNCTIONS  J1  AND  JO  WITH  ARGUMENTS  THAT 

ARE  ROOTS  OF  DERIVATIVES  OF  THE  BESSEL  FUNCTIONS 
SEE  5.21  AND  5.22  REFl 

Z1,Z0  RESULTS  OF  INTEGRATION  FOR  0  AND  90  DEGREES  CASES 
ZE,ZO  ZEROS  OF  DERIVATIVES  OF  J1  AND  JO 
Q,  DIPOLE  MOMENT/ (RADIUS**3) 

COMMON  /BLOCK9/  X (1001) ,Y1 (1001) ,y0 (1001) , Z1 (1001) , ZO (1001) ,  HS 

COMMON  /BLOCKl/  B  , R,  Q,  PI,  PSI 

COMMON  /BLOCK2/  ZE(20),  AX (20),  ZO(20),  BX(20) 

COMMON  /BLOCK7/  BE(20),  BO(20) 

GENERATE  POTENTIAL  ON  CYLINDER  HEAD=  CHAP-FERR  +  DIPOLE 


MAP28090 

MAP28100 

MAP28110 

MAP28120 

MAP28130 

MAP28140 

MAP28150 

MAP28160 

MAP28170 

MAP28180 

MAP28190 

MAP28200 

MAP28210 

MAP28220 

MAP28230 

MAP28240 

MAP28250 

MAP28260 

MAP28270 

MAP28280 

MAP28290 

MAP28300 

MAP28310 


C 

C 

C 


C 


C 


C 


C 


C 

C 

C 

C 

C 

C 

C 

c 


c 


c 


CALL  TAPOT(NDIM) 

GENERATE  COEFFICIENTS  FOR  N  ORDERS 
DO  1  N  »  1,  20 

FORM  INTEGRANDS  Y1  AND  YO 
CALL  FUN2(N,NDIM) 

DO  INTEGRATIONS  FOR  BOTH  TILT  CASES, RESULT  Zl,  ZO 
CALL  INTEGR(HS,Y1,Z1,NDIM) 

CALL  INTEGR(HS,Y0,Z0,NDiM) 

PREPARE  SOME  BESSEL  FACTORS 
BXO  -  BE(N)  *  BE(N) 

BYO  «  BO(N)  *  BO(N) 

ZEX  =  ZE(N)  *  ZE(N) 

COEFFICIENTS  A  AND  B  OF  5.24  AND  5.25  REFl 
AX(N)  -  Zl(NDIM)  *  ZEX  /  (BXO  *  (ZEX-1.)) 

BX(N)  -  ZO(NDIM)  /  (BYO) 

MODIFY  COEFFICIENTS  TO  SUIT  EXPRESSION  6.4  REFl 
AX(N)  -  AX(N)  *  ZE(N)  *  Q 
BX(N)  -  BX(N)  *  ZO(N)  *  2.  *  Q 
1  CONTINUE 

RETURN 

END 

***********************************;  TRANS3 
SUBROUTINE  TRANS3 (XV, YV, ZV, RR, T, PHI) 

PURPOSE-  CHANGE  CARTESIAN  TO  SPHERICAL  AND  FORM  TRIG.  FUNCTIONS 
FOR  COMMON  BLOCKS 

INPUT-  XV,YV,ZV  CARTESIAN  WITH  ZV  DOWN  TAIL 

OUTPUT-  RR,T,PHI  SPHERICAL  COORDINATES 

VARIABLES-  Q,  RATIO  DIPOLE  MOMENT/ (RADIUS**3) 

COMMON  /BLOCKl/  BEX, R, Q, PI , PSI 

COMMON  /BLOCKS/  CSPH, SNPH, QCS, QSN, CSPS, SNPS 

COMMON  /BLOCK 6/  CT,  ST 

RR  -  SQRT(XV*XV  +  YV*YV  +  ZV*ZV) 

PHI  -  ATAN3(YV,XV) 

T  -  ATAN3(SQRT(XV*XV+YV*YV) ,ZV) 

CT  -  COS(T) 

ST  -  SIN(T) 


MAP28320 

MAP28330 

MAP28340 

MAP28350 

MAP28360 

MAP28370 

MAP28380 

MAP28390 

MAP28400 

MAP28410 

MAP28420 

MAP28430 

MAP28440 

MAP28450 

MAP28460 

MAP23470 

MAP28480 

MAP28490 

MAP28500 

MAP28510 

MAP28520 

MAP28530 

MAP28540 

MAP28550 

MAP28560 

MAP28570 

MAP28580 

MAP28590 

MAP28600 

MAP28610 

MAP28620 

MAP28630 

MAP28640 

MAP28650 

MAP28660 

MAP28670 

MAP28680 

MAP28690 

MAP28700 

MAP28710 

MAP28720 


mapint.for 


CSPH  =  COS (PHI) 
SNPH  “  SIN (PHI) 
QCS  =  Q*CSPH 
QSN  -  Q*SNPH 


RETURN 

END 

k*******************************;  TRANS5 
SUBROUTINE  TRANS5 (XM, YM, ZM,  XV,YV, ZV,  XGSE, YGSE, ZGSE) 


PURPOSE-  TRANSFORM  M  TO  SPHERICAL  AND  GSE  SYSTEM 

INPUT-  XM,YM, ZM  THE  M  SYSTEM,  EARTH  CENTERED,  XM  DOWN  TAIL 

OUTPUT-  XV,YV, ZV  CARTESIAN,  SPHERE  CENTERED,  ZV  DOWN  TAIL 
XGSE, YGSE, ZGSE,  GSE  SYSTEM 
VARIABLES-  BEX,  =  RADIUS  -  STAND-OFF  DISTANCE 

COMMON  /BLOCKl/  BEX, R, Q, PI , PSI 
XV  -  ZM 
YV  -  -YM 
ZV  =  XM  -  BEX 

XGSE  -  -  XM 
YGSE  -  -YM 
ZGSE  -  +  ZM 


RETURN 

END 

SUBROUTINE  ZERO 


C  PURPOSE-  FILL  COMMON  BLOCKS  WITH  ZEROS  OF  BESSELS  AND  FUNCTION 
C  VALUES  AT  ZEROS 

C  INPUT-  SOURCE  IS  TABLE  9.5  REF2 
C  ZE, ZEROS  OF  Jl' (XI) 

C  ZO,  ZEROS  OF  JO' (YI) 

C  BE,  BESSEL  VALUE  Jl(XI) 

C  BO,  BESEL  VALUE  JO(YI) 

C 

COMMON  /BLOCK2/  ZE (20) , AX (20 ) , ZO (20) , BX (20) 

COMMON  /BLOCK?/  BE (20) , BO (20) 

C 


C  ZEROS  Jl' (XI)  =  0.0 

C 

ZE(1)»  1.84118 
ZE(2)-  5.33144 
ZE(3)=  8.53632 
ZE(4)-  11.70600 
ZE(5)-  14.86359 
ZE(6)-  18.01553 
ZE(7)=  21.16437 
ZE(8)-  24.31133 
ZE(9)-  27.45705 
ZE(IO)-  30.60192 
ZE(ll)-  33.74618 
ZE(12)-  36.88999 
ZE(13)-  40.03344 
ZE(14)«  43.17663 
ZE(15)-  46.31960 
ZE(16)-  49.46239 
ZE(17)-  52.60504 
ZE(18)-  55.74757 
ZE(19)-  58.89000 
ZE(20)-  62.03235 


MAP28730 

MAP28740 

MAP28750 

MAP28760 

MAP28770 

MAP28780 

MAP28790 

MAP28800 

MAP28810 

MAP28820 

MAP28830 

MAP28840 

MAP28850 

MAP28860 

MAP28870 

MAP28880 

MAP28890 

MAP28900 

MAP28910 

MAP28920 

MAP28930 

MAP28940 

MAP28950 

MAP2e960 

MAP28970 

MAP28980 

MAP28990 

MAP29000 

MAP29010 

MAP29020 

MAP29030 

MAP29040 

MAP29050 

MAP29060 

MAP29070 

MAP29080 

MAP29090 

MAP29100 

MAP29110 

MAP29120 

MAP29130 

MAP29140 

MAP29150 

MAP29160 

MAP29170 

MAP29180 

MAP29190 

MAP29200 

MAP29210 

MAP29220 

MAP29230 

MAP29240 

MAP29250 

MAP29260 

MAP29270 

MAP29280 

MAP2929C 

MAP29300 

MAP29310 

MAP29320 

MAP29330 

MAP29340 

MAP29350 

MAP29360 


mapint-for 


ZEROS  JO' (YI)  =0.0 

ZO(l)  -  3.8317059702 
ZO(2)  -  7.0155866698 
ZO(3)  -  10.1734681351 
ZO(4)  -  13.3236919363 
ZO(5)  -  16.4706300509 
ZO(6)  -  19.6158585105 
ZO(7)  =  22.7600843806 
ZO(8)  =  25.9036720876 
ZO(9)  -  29.0468285349 

ZO(IO)  »  32.1896799110 
ZO(ll)  -  35.3323075501 
ZO(12)  -  38.4747662348 
ZO(13)  -  41.6170942128 
ZO(14)  -  44.7593189977 
ZO(15)  -  47.9014608872 
ZO(16)  -  51.0435351836 
ZO(17)  -  54.1855536411 
ZO(18)  -  57.3275254379 
ZO(19)  -  60.4694578453 
ZO(20)  -  63.61141 


BE (I)  «  Jl(XI)  BESSELS  EVALUATED  AT  XI 'S  OF  ABOVE 

BE(1)-  +0.58187 
BE(2)-  -0.34613 
BE(3)”  +0.27330 
BE(4)-  -0.23330 
BE(5)-  +0.20701 
BE(6)-  -0.18802 
BE(7)=  +0.17346 

BE(8) - 0.16184 

BE(9)=  +0.15228 
BE(IO)-  -0.14424 
BE(ll)-  +0.13736 
BE(12)-  -0.13137 
BE(13)-  +0.12611 
BE(14)-  -0.12143 
BE(15)-  +0.11724 
BE(16)-  -0.11345 
BE(17)-  +0.11001 
BE(18)-  -0.10687 
BE(19)-  +0.10397 
BE(20)-  -0.10131 


BO(I)  =  JO(YI)  BESSELS  EVALUATED  AT  YI'S  OF  ABOVE 

BO(l)  -  -0.4027593957 
BO(2)  -  +0.3001157525 
BOO)  -  -0.2497048871 
BO(4)  -  +0.2183594072 
BO(5)  -  -0.1964653715 
BO(6)  -  +0.1800633753 
BO(7)  -  -0.1671846005 
BO(8)  =  +0.1567249836 
BO(9)  -  -0.1480111100 

BO(IO)  -  +0.1406057982 
BO(ll)  «  -0.1342112403 
BC(12)  -  +0.1286166221 


MAP29370 

MAP29380 

MAP29390 

MAP29400 

MAP29410 

MAP29420 

MAP29430 

MAP29440 

MAP29450 

MAP29460 

MAP29470 

MAP29480 

MAP29490 

MAP29500 

MAP29510 

MAP29520 

MAP29530 

MAP29540 

MAP29550 

MAP29560 

MAP29570 

MAP29580 

MAP29590 

MAP29600 

MAP29610 

MAP29620 

MAP29630 

MAP29640 

MAP29650 

MAP29660 

MAP29670 

MAP29680 

MAP29650 

MAP29700 

MAP29710 

MAP29720 

MAP29730 

MAP29740 

MAP29750 

MAP29760 

MAP29770 

MAP29780 

MAP29790 

MAP29800 

MAP29810 

MAP29820 

MAP29e30 

MAP29840 

MAP29850 

MAP29860 

MAP29870 

MAP29880 

MAP29890 

MAP29900 

MAP29910 

MAP29920 

MAP29930 

MAP29940 

MAP29950 

MAP29960 

MAP29970 

MAP29980 

MAP29990 

MAP30000 


mapint.for 


-0.1236679608 

+0.1192498120 

-0.1152736941 

+0.1116704969 

-0.1083853489 

+0.1053740554 

-0.1026005671 

+0.1000 


BO(13)  -  -0.1236679608  MAP30010 

BO(14)  -  +0.1192498120  MAP30020 

BO(15)  «  -0.1152736941  MAP30030 

BO(16)  »  +0.1116704969  MAP30040 

BO(17)  >»  -0.1083853489  MAP30050 

BO(18)  -  +0.1053740554  MAP30060 

BO(19)  -  -0.1026005671  MAP30070 

BO(20)  -  +0.1000  MAP30080 

MAP30090 

MAP30100 

RETURN  MAP30110 

END  MAP30120 

k******************************** :  bimf  MAP30130 

SUBROUTINE  BIMF(HIMF,XI,  HXM, H2M,  HXV,HZV,  HR,HT,HP,  HRHO, HZ, HPHI)MAP30140 

MAP30150 

PURPOSE-  DETERMINE  IMF  CONTRIBUTION  IN  CARTESIAN  M  AND  V, SPHER,  MAP30160 

AND  CYLINDRICAL  COORDINATES  MAP30170 

NO  Y  COMPONENT  INCLUDED  MAP30180 

INPUT-  HIMF,  MAGNITUDE  OF  IMF  (GAMMA)  MAP30190 

XI,  DIRECTION  OF  IMF,  0  DEGREES  IS  NORTHWARD,  90  ANTISUNMAP30200 


RETURN 

END 


INPUT- 


OUTPUT- 


VARIABLES- 


HXM,HZM  FIELD  VALUES  IN  M  SYSTEM,  HXM  DOWN  TAIL 
HXV,HZV  FIELD  VALUES  IN  V  SYSTEM,  H2V  DOWN  TAIL 
HR,HT,HP  "  "  "  SPHERICAL 

HRHO,  HZ,HPHI  "  ”  CYLINDRlCUiL 

ST,CT  SIN  AND  COS  OF  THETA 
SNPH,CSPH  SIN  AND  COS  OF  PHI 


COMMON  /BLOCK5/CSPH, SNPH, QCS, QSN, CSPS, SNPS 
COMMON  /BLOCK6/  CT,  ST 

DEGREES  TO  RADIANS 
AXI  «  XI*3. 1415926535/180.0 
M  SYSTEM 

HXM  =  HIMF  *  SIN (AXI) 

HZM  -  HIMF  *  COS (AXI) 

V  SYSTEM 

HXV  -  HZM 
HZV  -  HXM 

SPHERICAL  SYSTEM 
HR  -  +  HXV*ST*CSPH  +  HZV*CT 
HT  -  +  HXV*CT*CSPH  -  HZV*ST 
HP  -  -  HXV*SNPH 

CYLINDRICAL  SYSTEM 
HRHO  -  +  HXV  *  CSPH 
HPHI  -  +  HP 
HZ  =  +  HZV 


RETURN 

END 

***********************************1 
SUBROUTINE  CFDSPH (RR, HR, HT, HP) 


CFDSPH 


PURPOSE-  CALCULATE  FIELD  OF  CHAPMAN-FERRARO  CURRENTS  FOR 


MAP30210 

MAP30220 

MAP30230 

MAP30240 

MAP30250 

MAP30260 

MAP30270 

MAP30280 

MAP30290 

MAP30300 

MAP30310 

MAP30320 

MAP30330 

MAP30340 

MAP30350 

MAP30360 

MAP30370 

MAP30380 

MAP30390 

MAP30400 

MAP30410 

MAP30420 

MAP30430 

MAP30440 

MAP30450 

MAP30460 

MAP30470 

MAP30480 

MAP30490 

MAP30500 

MAP30510 

MAP30520 


SHIELDING  DIPOLE  ONLY  IN  SPHERE.  SUMMATION  OF  FIELD  DUE  MAP30530 
TO  POTENTIAL  5.11  REFl  MAP30540 

NOTE:  RECURRENCE  RELATIONS  JAHNKE-EMDE  NORMALIZED,  REF3  MAP30550 
INPUT-  RR,  RADIAL  LOCATION  MAP30560 

OUTPUT-  HR, HT,HP  SPHERICAL  FIELD  COMPONENTS,  5.2.13  REF4  MAP30570 

VARIABLES-  GAMl,GAMO  LEGENDRE  POLYNOMIAL  COEFFICIENTS  FROM  SPHRCO  MAP30580 
PN,  LEGENDRE  POLYNOMIAL  M=0  MAP30590 

CPN,  DERIVATIVE  OF  PN  W.R.T.  ARGUMENT  COS (THETA)  MAP30600 

TPN,  DERIVATIVE  OF  PN  W.R.T.  THETA  MAP30610 

PNM,  LEGENDRE  POLYNOMIAL  M=1  MAP30620 

TPNM,  DERIVATIVE  OF  PNM  W.R.T.  THETA  MAP30630 

SPNM,  QUOTIENT  PN/SIN (THETA)  MAP30640 


mapint.for 

31, Cl  SIN  AND  COS  OF  THETA 


DIMENSION  PN(20),  CPN(20),  TPN(20) 
DIMENSION  PNM(20) ,TPNM(20) ,SPNM(20) 

COMMON  /CHABLO/  GAM1(20),  GAM0(20) 

COMMON  /BLOCKl/  B,R,Q,PI,PSI 

COMMON  /BLOCK5/CSPH, SNPH, QCS, QSN, CSPS, SNPS 

COMMON  /BLOCK6/  Cl,  SI 

D  -  l.OE-03 

C2  -  C1*C1  -  S1*S1 
S2  -  2.*S1*C1 

PN(1)  -  Cl 

PN(2)  -  0.25* (3.*C2+1. ) 

CPN(l)  -  1.0 
CPN(2)  »  3.*C1 


DO  1  N-3,20 

FN  -  FLOAT (N) 

2FE  =  2.*FN  -  1.0 

PN(N)  -  (l./FN)  *  (ZFE*C1*PN(N-1) 

CPN(N)  *  ZFE*PN(N-1)  +  CPN(N-2) 
CONTINUE 


(FN-l.)*PN(N-2)) 


2  N=l,20 

FN  -  FLOAT (N) 


TPN(N)  - 
PNM(N)  - 
SPNM(N)  - 
TPNM(N)  - 
CONTINUE 

HRl  -  GAMl (1) 
HR2  -  GAMO(l) 
HTl  -  GAMl (1) 
HT2  »=  GAMO  (1) 
HP  =  GAMl (1) 


-  S1*CPN(N) 

-  TPN(N) 

+  CPN<N) 

FN* (FN+l.) *PN(N) 


PNM(l) 

PN(1) 

TPNM(l) 

TPN(l) 

SPNM(l) 


C1*CPN(N) 


RP  »  0.0 

IF(RR.GT.D)  RP  =  (RR/R) 
RRP  =  1.0 

DO  3  N-2,20 

FN  »  FLOAT (N) 

RRP  -  RRP  *  RP 

GAMA  =  GAMl  (N)  *  RRP 
GAME  -  GAMO  (N)  *  RRP 


1  AND  2  INDICATE  TERMS  MEANT  FOR  0  AND  90  DEGREE  CASES 


HRl 

= 

HRl 

+ 

GAMA 

* 

PNM{N) 

HR2 

- 

HR2 

+ 

GAME 

* 

PN(N) 

HTl 

s 

HTl 

+ 

GAMA 

* 

TPNM(N) / 

FN 

HT2 

- 

HT2 

+ 

GAME 

* 

TPN(N)  / 

FN 

HP 

HP 

+ 

GAMA 

* 

SPNM(N) / 

FN 

3  CONTINUE 


MAP30650 

MAP30660 

MAP30670 

MAP30680 

MAP30690 

MAP30700 

MAP30710 

MAP30720 

MAP30730 

MAP30740 

MAP30750 

MAP30760 

MAP30770 

MAP30780 

MAP30790 

MAP30800 

MAP30810 

MAP30820 

MAP30830 

MAP30840 

MAP30850 

MAP30860 

MAP30870 

MAP30880 

MAP30890 

MAP30900 

MAP30910 

MAP30920 

MAP30930 

MAP30940 

MAP30950 

MAP30960 

MAP30970 

MAP30980 

MAP30990 

MAP31000 

MAP31010 

MAP31020 

MAP31030 

MAP31040 

MAP31050 

MAP31060 

MAP31070 

MAP31080 

MAP31090 

MAP31100 

MAP31110 

MAP31120 

MAP31130 

MAP31140 

MAP31150 

MAP31160 

MAP31170 

MAP31180 

MAP31190 

MAP31200 

MAP31210 

MAP31220 

MAP31230 

MAP31240 

MAP31250 

MAP31260 

MAP31270 

MAP31280 


mapint.for 


RETURN 

END 

Q  iririfirifkiritirit'kic'kifkitifkii-kicifk'k'kic'kititifkitit'k'k 

SUBROUTINE  CFISPH (RR, HR, HT, HP) 


PURPOSE- 


CFISPH 


EACH  PART  RELATING  TO  TILT  CASES  IS  COMBINED  WITH  MAP31290 

FUNCTIONS  OF  5.9  REFl  MAP31300 

HR  =  -  (HRl  *  CSPH  *  CSPS  +  HR2  *  SNPS)  MAP31310 

HT  -  -  (HTl  *  CSPH  *  CSPS  +  HT2  *  SNPS)  MAP31320 

HP  -  +  HP  *  SNPH  *  CSPS  MAP31330 

MAP31340 

MAP31350 

RETURN  MAP31360 

END  MAP31370 

********************************:  CFISPH  MAP31380 

SUBROUTINE  CFISPH (RR, HR, HT, HP)  MAP31390 

MAP31400 

PURPOSE-  CALCULATE  CHAPMAN-FERRARO  FIELD  OUTSIDE  SHERE  DUE  TO  IMFMAP31410 
USING  5.15  REFl  MAP31420 

INPUT-  RR,  RADIAL  COORDINATE  MAP31430 

OUTPUT-  HR,HT,HP  CHAP-FERR  FIELD  COMPONENTS  IN  SPHERICAL  SYSTEM  MAP31440 
VARIABLES-  HR3,HT3,HP3  IMF  FIELD  COMPONENTS  FROM  SUBROUT.  BIMF  MAP31450 

MAP31460 

MAP31470 

COMMON  /BLOCKl/  BEX,  R,  Q,  PI,  PSI  MAP31480 

COMMON  /FIMF/  HIMF,  CDIPOL,  CIMF,  XI  MAP31490 

MAP31500 

GET  IMF  FIELD  COMPONENTS  MAP31510 

CALL  BIMF (HIMF, XI,  D1,D2,D3,D4,  HR3,HT3,HP3,  D5,D6,D7)  MAP31520 

TRANSFORM  COMPONENTS  TO  SPHERICAL  SYSTEM  MAP31530 

FR  =  R/RR  MAP31540 

FR  =  FR*FR*FR  MAP31550 

MAP31560 

HR  »  -  HR3  *  FR  MAP31570 

HT  =  +  0.5  *  HT3  *  FR  MAP31580 

HP  -  +  0.5  *  HP3  *  FR  MAP31590 

MAP31600 

RETURN  MAP31610 

END  MAP31620 

********************************.  bDIP  MAP31630 

SUBROUTINE  BDIP (RR, HR, HT, HP)  MAP31640 

MAP31650 

PURPOSE-  CALCULATE  EXPLICIT  COMPONENTS  OF  DIPOLE  USING  SPHERICAL  MAP31660 


COMMON  /BLOCKl/  BEX,  R,  Q,  PI,  PSI 
COMMON  /FIMF/  HIMF,  CDIPOL,  CIMF,  XI 
C 

C  GET  IMF  FIELD  COMPONENTS 

CALL  BIMF(HIMF,XI,  D1,D2,D3,D4,  HR3,HT3,HP3,  D5,D6,D7) 
C  TRANSFORM  COMPONENTS  TO  SPHERICAL  SYSTEM 

FR  =  R/RR 

FR  =  FR*FR*FR 

C 

HR  »  -  HR3  *  FR 

HT  =  +  0.5  *  HT3  *  FR 

HP  -  +  0.5  *  HP3  *  FR 

C 

RETURN 

END 

C  ***********************************;  BDIP 
SUBROUTINE  BDIP (RR, HR, HT, HP) 


PURPOSE- 


(GAMMA) 


EQUIVALENT  OF  5.6  REFl  FOR  POTENTIAL 
INPUT-  RR,  RADIAL  COORDINATE  LOCATION 

OUTPUT-  HR,HT,HP  DIPOLE  FIELD  IN  SPHERICAL  SYSTEM  (GAMMA) 
VARIABLES-  Cl, SI  COS  AND  SIN  OF  THETA 

R,  RADIUS  OF  SPHERE  AND  TAIL 
B,  -  R  -  STANDOFF  DISTANCE 

SNPS, CSPS  SIN  AND  COS  OF  PSI,  THE  DIPOLE  TILT  ANGLE 

COMMON  /BLOCKl/  B,R,Q,PI,PSI 

COMMON  /BLOCK5/CSPH, SNPH, QCS, QSN, CSPS, SNPS 

COMMON  /BLOCK6/  Cl,  SI 


QCS*R3 
»  QSN*R3 

( (RR*RR) 


(B*B) 


(2. *B*RR*C1) ) 


ABS (V) 
SIGN(1.C,V) 

SQRT(AV**3) 

SQRT(AV**5) 


MAP31670 

MAP31680 

MAP31690 

MAP31700 

MAP31710 

MAP31720 

MAP31730 

MAP31740 

MAP31750 

MAP31760 

MAP31770 

MAP31780 

MAP31790 

MAP31800 

MAP31810 

MAP31820 

MAP31830 

MAP31840 

MAP31850 

MAP31860 

MAP31870 

MAP31880 

MAP31890 

MAP31900 

MAP31910 

MAP31920 


oon  ooooo 


mapint.for 


2,*RR*B*S1 
2.*RR  +  2.*B*C1 
1.5*RR*G1/W2 
1.5*F1/W2 

'  A*CSPS*S1* (l./Wl  -  El) 

•  Q*R3*C1*SNPS* (1. /W1  -  El) 

■  -Q*R3*B*SNPS*3.* (RR+  B*C1)/W2 

-  A*CSPS* (Cl/Wl  +  S1*E2) 

-  Q*R3*SNPS* (C1*E2  -  Sl/Wl) 

•  Q*R3*B*SNPS* (3.*B*S1/W2) 

-AA*CSPS/W1 


RETURN 

END 

***********************************; 
SUBROUTINE  FUN1(N,NDIM) 


PURPOSE- 


INPUT- 


MAP31930 

MAP31940 

MAP31950 

MAP31960 

MAP31970 

MAP31980 

MAP31990 

MAP32000 

MAP32010 

MAP32020 

MAP32030 

MAP32040 

MAP32050 

MAP32060 

MAP32070 

MAP32080 

MAP32090 

MAP32100 

MAP32110 

MAP32120 

MAP32130 

MAP32140 

MAP32150 

MAP32160 

MAP32170 

MAP32180 

MAP32190 

MAP32200 

MAP32210 

MAP32220 


OUTPUT-  Yl,^ 
VARIABLES-  PNM, 
PN, 


FORM  INTEGRAND  FOR  COEFFICIENT  CALCULATIONS  AT  EACH  OF  MAP32190 
NDIM  STEPS  FOR  A  CERTAIN  ORDER  OF  LEGENDRE  POLYNOMIAL  MAP 322 00 
N,  ORDER  OF  LEGENDRE  POLYNOMIAL  MAP32210 
NDIM,  NUMBER  OF  GRID  POINTS  USED  FOR  INTEGRATION  MAP32220 
Yl,YO  VALUE  OF  INTEGRAND  FOR  CASES  0  AND  90  DEGREES  RESPMAP32230 
PNM,  LEGENDRE  POLYNOMIAL  M=I  MAP 322 40 
PN,  LEGENDRE  POLYNOMIAL  M»0  MAP32250 
ST,  SIN(T)  LAST  VALUE  COMES  FROM  SUBROUT.  LEGEN  MAP32260 


COMMON  /LEGl/  PN{20),  PNM(20),  CPN(20) 

COMMON  /BLOCKS/  W1 (1001) , WO (1001) 

COMMON  /BLOCK9/  X (1001) ,Y1 (1001) ,Y0 (1001) , Z1 (1001) , ZO (1001) , 
COMMON  /BLOCKS/  CT,  ST 


1  I  -  1,  NDIM 

X(I)  IS  THETA, 
CALL  LEGEN(X(I)  ,N) 

D  -  l.OE-20 

IF(ABS (W1 (I) ) .LT.D) 
IF(ABS(W0(I) ) .LT.D) 

IF  (ABS (PNM (N) ) .LT.D) 
IF(ABS(PN(N) ) .LT.D) 

IF (ABS (ST) .LT.D) 


GENERATES  LEGENDRE  POLYNOMIAL  TERMS 


W1 (I)  =0.0 
W0(I)  -  0.0 

PNM(N)  -  0.0 
PN(N)  -  0.0 
ST  =  0.0 


Y1  (I) 
Y0(I) 

CONTINUE 


NDIM  INTEGRANDS  FOR  EACH  ORDER  TO  GET  COEFFICIENTS 
5.2.3  REF4 

■  W1 (I)  *  PNM(N)  *  ST 
-  WO (I)  *  PN(N)  *  ST 


RETURN 

END 

Itlfkitliitltlfltltitititltltitltitiiltltifititiiititliititltltielrlt- 


BRDIP 


MAP32250 

MAP32260 

MAP32270 

MAP32280 

MAP32290 

MAP32300 

MAP32310 

MAP32320 

MAP32330 

MAP32340 

MAP32350 

MAP32360 

MAP32370 

MAP32380 

MAP32390 

MAP32400 

MAP32410 

MAP32420 

MAP32430 

MAP32440 

MAP32450 

MAP32460 

MAP32470 

MAP32480 

MAP32490 

MAP32500 

MAP32510 

MAP32520 

MAP32530 

MAP32540 

MAP32550 

MAP32560 


o  o  o  o  o  o  o 


c 

c 

c 

c 

c 

C 


mapint.for 


SUBROUTINE  BRDIP (NDIM) 


PURPOSE-  GENERATE  RADIAL  COMPONENTS  OF  DIPOLE  FIELD  ON  GRID  FOR 
TILT  0  AND  90  DEGREES 

INPUT-  NDIM,  NUMBER  OF  GRID  POINTS  AT  RADIUS=R  ALONG  CURVE 
THETA=0  TO  180  DEGREES  TO  BE  USED  FOR  INTEGRATION 
OUTPUT-  Wl,WO  RADIAL  COMPONENTS  OF  DIPOLE,  INTO  BLOCK  8 
VARIABLES-  KDIM,  NUMBER  OF  THE  GRID  POINT  SEPARATING  DAY  AND  NIGHT 
SIDE  OF  SPHERE 

R,  RADIUS  OF  SHPERE  AND  TAIL 
Q,  RATIO  DIPOLE  MOMENT/ (R**3) 

SNPH,CSPH  SIN  AND  COS  OF  PHI 
QSN,QCS  =Q*SNPH  AND  «Q*CSPH  RESPECTIVELY 
X(I),  THETA  VALUES  OF  GRID  POINTS 
HS,  GRID  POINT  SPACING 

COMMON  /BLOCKS/  W1 (1001 ), WO (1001 ) 

COMMON  /BLOCKS/  X  (1001)  ,  .'1  (1001)  ,Y0  (1001) ,  Z1  (1001)  ,  ZO  (1001)  ,  HS 

COMMON  /BLOCKl/  B,R,Q,PI,PSI 

COMMON  /BLOCKS/  CSPH, SNPH, QCS, QSN, CSPS, SNPS 

COMMON  /BLOCKS/  CT,  ST 

COMMON  /BLOCKS/  H0,ALFA,KSWIT 


KDIM  -  (NDIM-l)/2 


PHI 


0  DEGREES  FOR  THIS  SUBROUT, 


CSPH  -  1.0 
SNPH  -  0.0 
QCS  -  Q 
QSN  -  0.0 


GENERATE  GRID  POINTS 

X(l)  -  0.0 

HS  =  PI /FLOAT (NDIM-1) 

DO  1  1-2,  NDIM 

X(I)  -  FLOAT (I-l)  *  HS 
CONTINUE 

GET  COMPONENTS  FOR  TILT=0  DEGREES 

TI  -  0,0 
CALL  CONST (TI) 

DO  4  I-l,  NDIM 

CT  =  COS(X(I)  ) 

ST  -  SIN(X(I)  ) 

RRDIP  -  R 

GET  RADIAL  COMPONENT  OF  DIPOLE  AT  SPHERE  RADIUS 
CALL  BDIP(RRDIP,HR,HT,HP) 

W1  (I)  -  HR 

IF  (I.LE.KDIM)  THEN 

LOCATION  IS  NIGHTSIDE,  CHANGE  TO  CYLINDRICAL 
RHO-  R  *  ST 
Z  -  R  *  CT 

GE"^  CYLINDER  SOLUTION 
CALL  VACTA(Z,RHO,HR,HZ,HP) 

HR  -  HR  *  ST  +  HZ  *  CT 

CYLINDER  SOLUTION  HAS  DIPOLE  +  CHAP-FERR  5.16  REFl 
W1 (I)  «  W1 (1)  -  HR 

ELSE 

LOCATION  IS  DAYSIDE  OF  SPHERE 


MAP32570 

MAP32580 

MAP32590 

MAP32600 

MAP32610 

MAP32620 

MAP32630 

-MAP32640 

MAP32650 

MAP32660 

MAP32670 

MAP32680 

MAP32690 

MAP32700 

MAP32710 

MAP32720 

MAP32730 

MAP32740 

MAP32750 

MAP32760 

MAP32770 

MAP32780 

MAP32790 

MAP32800 

MAP32810 

MAP32820 

MAP32830 

MAP32840 

MAP32850 

MAP32860 

MAP32870 

MAP32880 

MAP32890 

MAP32900 

MAP32910 

MAP32920 

MAP32930 

MAP32940 

MAP32950 

MAP32960 

MAP32970 

MAP32980 

MAP32990 

MAP33000 

MAP33010 

MAP33020 

MAP33030 

MAP33040 

MAP33050 

MAP33060 

MAP33070 

MAP33080 

MAP33090 

MAP33100 

MAP33110 

MAP33120 

MAP33130 

MAP33140 

MAP33150 

MAP33160 

MAP33170 

MAP33180 

MAP33190 

MAP33200 


50 


oo  oooooooooo  oo  o  o  ooo  oooo  oo 


Ji''' 

'  'U  Vi  i  <•  t 


mapint.for 


RRSHE  «  R 

C  DAYSIDE  FIELD  RESULTING  FROM  TAIL 

CALL  BTASPH(RRSHE,HR,HT,HP) 

DIPOLE  PLUS  DAYSIDE  TAIL  SOLUTION 
FIELD,  5.1  REFl 
W1 (I)  «  W1 (I)  +  HR 
END  IF 
CONTINUE 


SOLUTION 
GIVES  DAYSIDE 


GENERATE  COMPONENTS  FOR  Tl-LT-SO  DEGREES 
(SAME  PROCEDURE  AS  ABOVE  FOR  TILT=0  DEGREES) 

TI  -  90,0 
CALL  CONST (TI) 


DO  7  1=1,  NDIM 

CT  -  COS(X(I) ) 

ST  -  S1N(X(I)  ) 

RRDIP  «  R 

CALL  BDIP (RRDIP,HR,HT,HP) 

WO (I)  -  HR 

IF  (I.LE.KDIM)  THEN 
RHO-  R  *  ST 
Z  -  R  *  CT 

CALL  VACTA(Z,RHO,HR,HZ,HP) 
HR  -  HR  *  ST  +  HZ  *  CT 
WO (I)  -  WO (I)  -  HR 

ELSE 

RRSHE  -  R 

CALL  BTASPH(RRSHE,HR,HT,HP) 
WO (I)  -  WO (I)  +  HR 
END  IF 
7  CONTINUE 


RETURN 

END 

***********************************.  INTEGR 
SUBROUTINE  INTEGR(H, Y, Z,NDIM) 

PURPOSE-  GENERAL  INTEGRATION  ROUTINE 

INPUT-  H,  GRID  SIZE 

Y,  INTEGRAND,  FROM  FUNl  OR  FUN2  SUBROUT, 

NDIM,  NUMBER  OF  GRID  POINTS  USED 
OUTPUT-  Z  INTEGRAL  RESULT  OF  FUNCTION  Y  FROM  ZERO  TO  NDIM*H 
(USED  TO  FILL  Z1  AND  ZO  OF  BLOCK  9) 

DIMENSION  Y (NDIM) ,  Z (NDIM) 

HT-.3333333*H 

IF(NDIM-5)7,8,1 

NDIM  IS  GREATER  THAN  5.  PREPARATIONS  OF  INTEGRATION  LOOP 
1  SUM1-Y(2)+Y(2) 

SUMl-SUMl+SUMl 
SUMl-HT* (Y(1)+SUM1+Y(3) ) 

AUX1-Y(4)+Y(4) 

AUXl-AUXl+AUXl 

AUXl-SUMl+HT* (Y (3) +AUX1+Y (5) ) 

AUX2-HT* (Y(l)+3.875* (Y (2) +Y (5) ) +2 . 625* (Y (3) +Y (4 ) ) +Y (6) ) 


MAP33210 

MAP33220 

MAP33230 

MAP33240 

MAP33250 

MAP33260 

MAP33270 

MAP33280 

MAP33290 

MAP33300 

MAP33310 

MAP33320 

MAP33330 

MAP33340 

MAP33350 

MAP33360 

MAP33370 

MAP33380 

MAP33390 

MAP33400 

MAP33410 

MAP33420 

MAP33430 

MAP33440 

MAP33450 

MAP33460 

MAP33470 

MAP33480 

MAP33490 

MAP33500 

MAP33510 

MAP33520 

MAP33530 

MAP33540 

MAP33550 

MAP33560 

MAP33570 

MAP33580 

MAP33590 

MAP33600 

MAP33610 

MAP33620 

MAP33630 

MAP33640 

MAP33650 

MAP33660 

MAP33670 

MAP33680 

MAP33690 

MAP33700 

MAP33710 

MAP33720 

MAP33730 

MAP33740 

MAP33750 

MAP33760 

MAP33770 

MAP33780 

MAP33790 

MAP33800 

MAP33810 

MAP33820 

MAP33830 

MAP33840 


SUM2-AUX2-HT* (Y (4) +SUM2+y (6) ) 
Z{l)-0. 

AUX-Y(3)+Y(3) 

AUX-AUX+AUX 


Z(2)-SUM2-HT* (Y(2)+AUX+Y(4) ) 

Z(3)=»SUM1 

Z<4)=SUM2 

IF (NDIM-6)5,5,2 


mapint,for 


c 

C  INTEGRATION  LOOP 

2  DO  4  I-7,NDIM,2 
SUMl-AUXl 
SUM2-AUX2 

AUX1-Y(I-1)+Y(I-1) 

AUXl-AUXl+AUXl 

AUXl-SUMl+HT* (Y(I-2)+AUXl+Y(I) ) 

Z{I-2)-SUMl 

IF<I-NDIM)3,6,6 

3  AUX2=Y(I)+Y{I) 

AUX2=AUX2+AUX2 

AUX2=SUM2+HT* {Y(I-1)+AUX2+Y(I+1) ) 

4  Z(I-1)-SUM2 

5  Z (NDIM-1)=AUX1 
Z (NDIM) =AUX2 
RETURN 

6  Z (NDIM-1)-SUM2 
Z (NDIM) -AUXl 
RETURN 

C  END  OF  INTEGRATION  LOOP 
C 


7  IF<NDIM-3)12,11,8 
C 

C  NDIM  IS  EQUAL  TO  4  OR  5 

8  SUM2-1.125*HT* (Y (1) +Y (2) +Y (2) +y (2) +Y (3) +Y (3) +Y (3) +Y (4 ) ) 
SUM1-Y(2)+Y(2) 

SUMl-SUMl+SUMl 
SUMl-HT* (Y(1)+SUM1+Y(3) ) 

Z<l)-0. 

AUXl-Y(3)+y (3) 

AUXl -AUXl +AUX1 

Z  (2)-SUM2-HT* {Y(2)+AUX1+Y(4) ) 

IF(NDIM-5)10,9,9 

9  AUXl-Y{4)+y(4) 

AUXl-AUXl+AUXl 

Z (5)  -SUMl+HT* (Y (3) +AUX1+Y (5) ) 

10  Z{3)-SUM1 
Z(4)-SUM2 
RETURN 


C 

C  NDIM  IS  EQUAL  TO  3 

11  SUMl-HT* (1.25*Y (1)+Y(2)+Y(2) -.25*Y(3) ) 

SUM2=Y(2)+Y(2) 

SUM2=SUM2+SUM2 
Z(3)-HT* (Y(1)+SUM2+Y(3) ) 

Z(l)-0. 

Z(2)-SUM1 

12  RETURN 
END 

C  *********************************★*.  BTRAN2 

SUBROUTINE  BTRAN2  (HRV,  HZV,  HPV,  HXV,  HYV,  HZW) 

C 

C  PURPOSE-  CHANGE  FIELD  COMPONENTS  FROM  CYLINDRICAL  TO  CARTESIAN 


MAP33850 

MAP33860 

MAP33870 

MAP33880 

MAP33890 

MAP33900 

MAP33910 

MAP33920 

MAP33930 

MAP33940 

MAP33950 

MAP33960 

MAP33970 

MAP33980 

MAP33990 

MAP34000 

MAP34010 

MAP34020 

MAP34030 

MAP34040 

MAP34050 

MAP34060 

MAP34070 

MAP34080 

MAP34090 

MAP34100 

MAP34110 

MAP34120 

MAP34130 

MAP34140 

MAP34150 

MAP34160 

MAP34170 

MAP34180 

MAP34190 

MAP34200 

MAP34210 

MAP34220 

MAP34230 

MAP34240 

MAP34250 

MAF34260 

MAP34270 

MAP34280 

MAP34290 

MAP34300 

MAP34310 

MAP34320 

MAP34330 

MAP34340 

MAP34350 

MAP34360 

MAP34370 

MAP343flO 

MAP34390 

MAP34400 

MAP34410 

MAP34420 

MAP34430 

MAP34440 

MAP34450 

MAP34460 

MAP34470 

MAP34480 
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C  INPUT-  HRV,HZV,HPV  CYLINDRICAL  FIELD  COMPONENTS,  HZV  DOWN  TAILMAP34490 

C  OUTPUT-  HXV,HYV,HZW  CARTESIAN  COMPONENTS,  HZW  DOWN  TAIL  MAP34500 

C  VARIABLES-  SP,CP  SIN  AND  COS  OF  PHI  MAP34510 

C  MAP34520 

COMMON  /BLOCKS/  CP, SP, QCS, QSN, CSPS, SNPS  MAP34530 

C  MAP34540 

HXV  -  HRV^CP  -  HPV*SP  MAP34550 

HYV  -  HRV*SP  +  HPV*CP  MAP34560 

HZW  »  HZV  MAP34570 

C  MAP34580 

RETURN  MAP34590 

END  MAP34600 

C  ***********************************:  BTASPH  MAP34610 

SUBROUTINE  BTASPH (RR, HR, HT, HP)  MAP34620 

C  MAP34630 

C  PURPOSE-  CALCULATE  FIELD  COMPONENTS  OF  TAILFIELD  WITHIN  SPHERE  MAP34640 

C  FOR  ZV<0.  (IMAGE  OF  VACTA)  COMPONENTS  DERIVED  FROM  5.26  MAP34650 

C  REFl  WITH  SIGN  CHANGE  IN  EXPONENT  DUE  TO  ZV  POSITION  MAP34660 

C  FIRST  CALLED  FROM  SPHRCO  ON  ITERATION  2.  15  TERMS  USED.  MAP34670 

C  INPUT-  RR,  RADIAL  DISTANCE  IN  SPHERICAL  COORDINATES  MAP34680 

C  OUTPUT-  HR,HT,HP  SPHERICAL  FIELD  COMPONENTS  MAP34690 

C  VARIABLES-  RHO, Z  CYLINDRICAL  EQUIVALENTS  OF  INPUT  MAP34700 

C  ST,CT  SIN  AND  COS  OF  THETA  MAP34710 

C  ZE,  ZEROS  OF  Jl' {  )  BESSEL  5.23  REFl  MAP34720 

C  ZO,  ZEROS  OF  JO' (  )  BESSEL  "  MAP34730 

C  AX,BX  FOURIER-BESSEL  COEFFICIENTS  WITH  ADDITIONS  MAP34740 

C  ALPHA,  PLASMA  CONTENT  OF  TAIL  1  MEANS  VACUUM  MAP34750 

C  0  MEANS  HARRIS  SHEET  MAP34760 

C  ALPHA=1  USED  TO  GET  COEFFICIENTS  MAP 34 770 

C  ALPHA  NOT  “  1  ONLY  POSSIBLE  FOR  BTOTAL  A’’PLICATION  MAP34780 


INPUT- 
OUTPUT  - 


COMMON  /BLOCKl/  B,R,Q,PI,PSI 

COMMON  /BLOCK2/  ZE  (20) , AX (20) , ZO (20) ,  BX (20) 

COMMON  /BLOCK5/CSPH, SNPH, QCS, QSN, CSPS,  SNPS 

COMMON  /BLOCKS/  CT,ST 

COMMON  /BLOCK3/  HO, ALFA, KSWIT 

CHANGE  INPUT  TO  CYLINDRICAL  COORDINATES 
RHO  *  RR  *  ST 
Z  -  RR  *  CT 

FL  -  0.5  *  (l.-ALFA) 


D  -  l.OE-02 


DO  100  I 

ARX  • 
ARZ  • 
TARX 
TARZ 


'  ZE(I) /R  *  RHO 
'  ZE(I)/R  *  Z 
»  ZO(I) /R  *  RHO 
-  ZO(I)/R  *  Z 

EXP (+ ARZ) 

EX  *  FL  *  AX (I) 

•  EXP(+TARZ) 

«  TEX  *  FL  *  BX(I) 


MAP34680 

MAP34690 

MAP34700 

MAP34710 

MAP34720 

MAP34730 

MAP34740 

MAP34750 

MAP34760 

MAP34770 

MAP34780 

MAP34790 

MAP34800 

MAP34810 

MAP34820 

MAP34830 

MAP34840 

MAP34850 

MAP34860 

MAP34870 

MAP34880 

MAP34890 

MAP34900 

MAP34910 

MAP34920 

MAP34930 

MAP34940 

MAP34950 

MAP34960 

MAP34970 

MAP34980 

MAP34990 

MAP35000 

MAP35010 

MAP35020 

MAP35030 

MAP35040 

MAP35050 

MAP35060 

MAP35070 

MAP35080 

MAP35090 

MAP35100 

MAP35110 

MAP35120 


on  non 
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IF{ABS(RHO) .GE.l.OE-06)  THEN 


BO 

B1 

B2 

TBO 

TBl 

END  IF 


BFJO (ARX) 

BFJl (ARX) 

BFJ2 (B1,B0,ARX) 
BFJO (TARX) 

BFJl (TARX) 

HHR  +  (B0-B2)*EX 
HHP  +  (B0+B2)*EX 
HHZ  +  2.0*B1*EX 

THR  +  TBl* TEX 
THZ  +  TBO* TEX 


100  CONTINUE 


HHR  -  HHR*CSPS*CSPH 
HHP  =  HHP*CSPS*  SNPH 
HHZ  ■  HHZ*CSPS*CSPH 
THR  -  THR*SNPS 
THZ  =  THZ*SNPS 


HHR  -  -  HHR  +  THR 

HHP  -  +  HHP 

HHZ  -  -  HHZ  -  THZ 

OUTPUT  IN  SPHERICAL  COORDINATES 
HR  «  HHR*ST  +  HHZ*CT 
HT  -  HHR*CT  -  HHZ*ST 
HP  -  HHP 

RETURN 

END 

***********************************.  ATAN3 
FUNCTION  ATAN3(Y,X) 

PI  -  3.1415926535 
ATAN3  -  0.00 

IF( (X.NE.0.0)  .OR.  (Y.NE.O.O) )  ATAN3  =  ATAN2(Y,X) 

RETURN 

END 

****************************★******;  BFJO 
FUNCTION  BFJO (X) 

PURPOSE-  CALCULATE  BESSEL  FUNCTION  JO (X) 

USING  9.4.1  AND  9.4.3  OF  REF2  TO  ORDER  12  APPROXIMATION 
INPUT-  X,  ARGUMENT  OF  THE  BESSEL  FUNCTION 
OUTPUT-  BFJO (X) ,  =J0 (X) 

DATA  A1/-2. 2499997/, A2/1. 2656208/, A3/-0. 3163866/, A4/0. 0444479/, 

1  A5/-0. 0039444/, A6/0. 00021 /,B0/0. 79788456/, B1/-0. 00000077/, 

2  B2/-0. 0055274/, B3/-0. 00009512/, B4/0. 00137237/, B5/-0. 00072805/, 

3  B6/0. 00014476/, C0/-0. 78539816/, C1/-0. 04166397/, C2/-0. 00003954/, 

4  C3/0. 00262573/, C4/-0. 00054125/, C5/-0. 00029333/, C6/0. 00013558/ 

XO-ABS (X) 

T-XO/3.0 


MAP35130 

MAP35140 

MAP35150 

MAP35160 

MAP35170 

MAP35180 

MAP35190 

MAP35200 

MAP35210 

MAP35220 

MAP35230 

MAP35240 

MAP35250 

MAP35260 

MAP35270 

MAP35280 

MAP35290 

MAP35300 

MAP35310 

MAP35320 

MAP35330 

MAP35340 

MAP35350 

MAP35360 

MAP35370 

MAP35380 

MAP35390 

MAP35400 

MAP35410 

MAP35420 

MAP35430 

MAP35440 

MAP35450 

MAP35460 

MAP35470 

MAP35480 

MAP35490 

MAP35500 

MAP35510 

MAP35520 

MAP35530 

MAP35540 

MAP35550 

MAP35560 

MAP35570 

MAP35580 

MAP35590 

MAP35600 

MAP35610 

MAP35620 

MAP35630 

MAP35640 

MAP35650 

MAP35660 

MAP35670 

MAP35680 

MAP35690 

MAP35700 

MAP35710 

MAP35720 

MAP35730 

MAP35740 

MAP35750 

MAP35760 
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c 

IF  (T.LT.1.0)  THEN 

C  USE  EQ.  9.4.1 

Hl-1 . 0+T* (Al+T* (A2+T* (A3+T* (A4+T* (A5+T*A6) ) ) ) ) 
BFJO-Hl 

ELSE 

C  USE  EQ.  9.4.3 

T=1.0/T 

H2  -BO+T* (Bl+T* (B2+T* (B3+T* (B4+T* (B5+T*B6) ) ) ) ) 
H3-X0+C0+T* (Cl+T* (C2+T* (C3+T* (C4+T* (C5+T*C6) ) ) ) ) 
BFJ0»H2*COS (H3) /SQRT(XO) 

END  IF 
RETURN 
END 

C  **********★*****************★*****★:  BFJl 


C 

C 

C 

C 

C 

C 


C 


C 

c 


FUNCTION  BFJl (X) 

PURPOSE-  CALCULATE  BESSEL  FUNCTION  J1 (X) 

USING  9.4.4  AND  9.4.6  REF2  TO  ORDER  12  APPROXIMATION 
INPUT-  X,  ARGUMENT  OF  BESSEL  FUNCTION 
OUTPUT-  BFJl,  BESSEL  FUNCTION  J1 (X) 

DATA  Al/-. 56249985/, 

1  A2/. 21093573/, A3/-. 03954289/, A4/. 00443319/, A5/-. 00031^61/ , 

2  A6/, 00001109/, BO/. 79788456/, Bl/. 00000156/,  B2/.  01659667/, 

3  B3/. 00017105/, B4/-. 00249511/, B5/. 00113653/, B6/-. 00020033/, 

4  C0/-2. 35619449/, Cl/. 12499612/, C2/. 0000565/, C3/-. 00637879/, 

5  C4/, 00074348/, C5/. 00079824/, C6/-. 00029166/ 

XO-ABS (X) 

X1-SIGN(1.0,X) 

T-XO/3.0 

IF  (T.LT.1.0)  THEN 
USE  9.4.4 

T— t*t 

Hl-0 . 5+T* (Al+T* (A2+T* (A3+T* (A4+T* (A5+T*A6) ) ) ) ) 

BFJ1-X*H1 


ELSE 

C  USE  9.4.6 

T-l.O/T 

H2-B0+T* (Bl+T* (B2+T* (B3+T* (B4+T* (B5+T*B6) ) ) ) ) 
H3-X0+C0+T* (Cl+T* (C2+T* (C3+T* {C4+T* (C5+T*C6) ) ) ) ) 
BFJ1-X1*H2*C0S(H3) /SQRT(XO) 

END  IF 
RETURN 
END 

C  ***********************************.  BFJ2 
FUNCTION  BFJ2 (B1,B0,X) 

C 

C  PURPOSE- 

C  INPUT- 

C 
C 

C  OUTPUT- 

C 

BFJ2  -  0.0 
IF(X.GT.O.O)  THEN 

BFJ2  -  (2./X)  *  Bl  -  BO 
END  IF 
C 


CALCULATE  BESSEL  FUNCTION  J2 (X)  USING  9.1.27  REF2 
Bl,  J1(X)  BESSEL  FROM  FUNCTION  BFJl 
BO,  J0(X)  BESSEL  FROM  FUNCTION  BFJO 
X,  ARGUMENT  OF  BESSEL  FUNCTIONS 
BFJ2,  BESSEL  J2 (X) 


RETURN 

END 


MAP35790 
MAP35800 
MAP35810 
MAP35820 
MAP35830 
MAP35840 
MAP35850 
MAP35860 
MAP35870 
MAP35880 
MAP35890 
MAP35900 
MAP35910 
MAP35920 
MAP35930 
MAP35940 
MAP35950 
MAP35960 
MAP35970 
MAP35980 
MAP35990 
MAP36000 
MAP36010 
MAP36020 
MAP36030 
MAP36040 
MAP36050 
MAP36060 
MAP36070 
MAP36080 
MAP36090 
MAP36100 
MAP36110 
MAP36120 
MAP36130 
MAP36140 
MAP36150 
MAP36160 
MAP36170 
MAP36180 
MAP36190 
MAP36200 
MAP36210 
MAP 3 6220 
MAP36230 
MAP36240 
MAP36250 
MAP36260 
MAP36270 
MAP36280 
MAP36290 
MAP36300 
MAP36310 
MAP36320 
MAP36330 
MAP36340 
MAP36350 
MAP36360 
MAP36370 
MAP36380 
MAP36390 
MAP36400 


no  o  n  o  ooo  ooooooooooooo  o  no  non 
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titii'ltifiiit'klt'k'kit'kit'kicicifkitifiticitifitifkii'k  • 

SUBROUTINE  CFITA (RR, HR, HZ, HP) 


CFITA 


PURPOSE-  CALCULATE  CHAPMAN-FERRARO  FIELD  OF  IMF  OUTSIDE 
INPUT-  RR  RHO  IN  CYLINDRICAL  COORDINATES 
OUTPUT-  HR, HZ, HP  CYLINDRICAL  FIELD  COMPONENTS 
VARIABLES-  HIMF,  STRENGTH  OF  IMF  FIELD 
XI,  IMF  ANGLE 

R,  RADIUS  OF  MAGNETOPAUSE  SPHERE  AND  TAIL 

COMMON  /BLOCKl/  BEX,  R,  Q,  PI,  PSI 
COMMON  /FIMF/  HIMF,  CDIPOL,  CIMF,  XI 

GET  IMF  FIELD  COMPONENTS 

CALL  BIMF(HIMF,XI,  D1 , D2, D3, D4 , D5, D6, D7,  HR3,HZ3,HP3) 

FR  -  R/RR 

FR  -  FR*FR*FR 

COMPONENTS  DERIVED  FROM  5.30  REFl 

HR  -  -  HR3  *  FR 

HZ  -  +  0.5  *  HZ3  *  FR 

HP  -  +  0.5  *  HP3  *  FR 

RETURN 

END 

***********************************.  FUN2 
SUBROUTINE  FUN2(N,NDIM) 


PURPOSE-  CALCULATE  INTEGRAND  FOR  FOURIER-BESSEL  INTEGRALS. 

FOR  EACH  OF  NDIM  GRID  POINTS.  DONE  FOR  TILT  0  AND 
INPUT-  N,  ORDER  OF  BESSEL  FUNCTION 
NDIM,  NUMBER  OF  GRID  POINTS 

OUTPUT-  Y1,Y0  INTEGRANDS  FOR  TILT  0,  90  DEGREES,  5.24,5.25 
OUTPUT  TO  BLOCK  9 

VARIABLES-  ZE,  ZEROS  OF  DERIVATIVES  OF  BESSEL  J1 
20,  on  t.  "  "  JO 

X,  RADIAL  VALUES  OF  GRID  POINTS 
R,  RADIUS  OF  TAIL  CYLINDER 

COMMON  /BLOCKS/  W1 (1001) , WO (1001) 

COMMON  /BLOCK9/  X (1001) ,Y1 (1001) ,Y0 (1001) , Z1 (1001) , ZO (1001) , 

COMMON  /BLOCKl/  B  ,R,  Q,  PI,  PSI 

COMMON  /BLOCK2/  ZE(20),  AX (20),  ZO(20),  BX(20) 


I  «  1,  NDIM 

ARGUMENTS  OF  BESSELS 
ARX  -  ZE(N)  *  X(I)  /  R 
TARX  -  ZO(N)  *  X(I)  /  R 

SET  BESSEL  VALUES  FOR  VERY  SMALL  ARGUMENTS 

B1  =  0.0 
BO  -  1.0 

1F(ABS(X(I) ) .GE.l.OE-06)  THEN 

GET  BESSEL  FUNCTION  VALUES  J1  AND  JO 
B1  »  BFJl (ARX) 


BO 

END  IF 


Y1(I) 

Y0(I) 


BFJO (TARX) 

INTEGRANDS  OF 
I  -  X(I)  *  W1  (I) 

I  -  X(I)  *  W0(I) 


.24  AND  5.25  REFl 
B1 


CONTINUE 


MAP36410 
MAP36420 
MAP36430 
CYLINDER  MAP36440 
MAP36450 
MAP36460 
MAP36470 
MAP36480 
MAP36490 
MAP36500 
MAP36510 
MAP36520 
MAP36530 
MAP36540 
MAP36550 
MAP36560 
MAP36570 
MAP36580 
MAP36590 
MAP36600 
MAP36610 
MAP36620 
MAP36630 
MAP36640 
MAP36650 
MAP36660 
MAP36670 
MAP366eO 
MAP36690 
,S.  ONE  MAP36700 
Uro  90  DEGMAP36710 
MAP36720 
MAP36730 
5.25  REFl  MAP36740 
MAP36750 
MAP36760 
MAP36770 
MAP36780 
MAP36790 
MAP36800 
MAP36810 
)1),  HS  MAP36820 
MAP36830 
MAP36840 
MAP36850 
MAP36860 
MAP36870 
MAP36880 
MAP36890 
MAP36900 
5  MAP36910 

MAP36920 
MAP36930 
MAP36940 
MAP36950 
MAP36960 
MAP36970 
MAP36980 
MAP36990 
MAP37000 
MAP37010 
MAP37020 
MAP37030 
MAP37040 


mapiiit.for 


RETURN 

END 

ititifkititititititititiiic'k-kif'kii'klcitititifkititiiiticit'kiiit’ 

SUBROUTINE  LEGEN(T,NE) 


LEGEN 


PURPOSE-  CALCULATE  LEGENDRE  POLYNOMIAL  TERMS 
INPUT-  T,  THETA  OF  SPHERICAL  SYSTEM 

NE,  ORDER  OF  LEGENDRE  POLYNOMIAL 
OUTPUT-  PN,  LEGENDRE  POLYNOMIAL  TERMS  M=0 

CPN,  DERIVATIVE  OF  PN  W.R.T.  COS (T) 
PNM,  LEGENDRE  POLYNOMIAL  TERMS  M=1 

COMMON  /LEGl/  PN(20),  PNM (20),  CPN (20) 

COMMON  /BLOCKS/  Cl,  SI 

Cl  -  COS(T) 

51  ■  SIN(T) 

C2  *  C1*C1  -  S1*S1 

52  -  2.*S1*C1 

PN(1)  -  Cl 

PN(2)  =  0.25*  (3.*C2+1.) 


CPN(l) 
CPN (2) 


1.0 

3.*C1 


PNM(l)  -  +  SI  *  CPN(l) 
PNM(2)  -  +  SI  *  CPN(2) 


IF(NE.LT.3)  RETURN 
IF(NE.EQ.3)  NELE=  4 

IF(NE.GT.3)  NELE-  NE 

DO  1  N- 3, NELE 

FN  -  FLOAT (N) 

ZFE  -  2,*FN  -  1.0 

RECURRENCE  RELATION  FROM  REF3  JAHNKE-EMDE  NORMALIZED 
PN(N)  =  (l./FN)  *  (ZFE*C1*PN(N-1)  -  (FN-1 . ) *PN (N-2) ) 
CPN(N)  »  ZFE*PN(N-1)  +  CPN (N-2) 

PNM(N)  -  +  S1*CPN(N) 

CONTINUE 


RETURN 

END 


BTATA 


***********************************.  ] 
SUBROUTINE  BTATA (Z, RHO, HHR,  HHZ,  HHP) 


PURPOSE-  CALCULATE  COMPONENTS  OF  TAILFIELD  SOLUTION  FOR  ZV>0 
IINCLUDING  STRETCH, SUMMARIES  6.3  AND  6.4  REFl 
INPUT-  Z,RHO  CYLINDRICAL  COORDINATES 

OUTPUT-  HHR, HHZ, HHP  CYLINDRICAL  FIELD  COMPONENTS 

VARIABLES-  ALFA,  PLASMA  CONTENT  STRETCH  PARAMETER 

SNPH,CSPH  SIN  AND  COS  OF  PHI,  A  CYLINDRICAL  COORDINATE 
SNPS,CSPS  SIN  AND  COS  OF  PSI,  THE  DIPOLE  TILT  ANGLE 
AX,BX  COEFFICIENTS  FOR  FOURIER-BESSEL  SERIES 
R,  RADIUS  OF  TAIL 

ZE,ZO  ZEROS  OF  BESSEL  FUNCTION  DERIVATIVES  5.25  REFl 

COMMON  /BLOCKl/  B,R,Q,PI,PSI 

COMMON  /BL(X:K2/  ZE  (20)  ,  AX  (20)  ,  ZO  (20)  ,BX  (20) 

COMMON  /BLOCK5/CSPH,SNPH,(}CS,QSN,CSPS,SNPS 


MAP37050 

MAP37060 

MAP37070 

MAP37080 

MAP37090 

MAP37100 

MAP37110 

MAP37120 

MAP37130 

MAP37140 

MAP37150 

MAP37160 

MAP37170 

MAP37180 

MAP37190 

MAP37200 

MAP37210 

MAP37220 

MAP37230 

MAP37240 

MAP37250 

MAP37260 

MAP37270 

MAP37280 

MAP37290 

MAP37300 

MAP37310 

MAP37320 

MAP37330 

MAP37340 

MAP37350 

MAP37360 

MAP37370 

MAP37380 

MAP37390 

MAP37400 

MAP37410 

MAP37420 

MAP37430 

MAP37440 

MAP37450 

MAP37460 

MAP37470 

MAP37480 

MAP37490 

MAP37500 

MAP37510 

MAP37520 

MAP37530 

MAP37540 

MAP37550 

MAP37560 

MAP37570 

MAP37580 

MAP37590 

MAP37600 

MAP37610 

MAP37620 

MAP37630 

MAP37640 

MAP37650 

MAP37660 

MAP37670 

MAP37680 


o  o 


COMMON  /BLOCK6/  CT, ST 
COMMON  /BLOCKS/  HO, ALFA, KSWIT 


HHR  -  0.0 
HHZ  -  0.0 
HHP  -  0.0 
THR  -  0.0 
THZ  «  0.0 
D  =  l.OE-02 
C 


IF(ABS(ALFA) .LT.l.OE-06)  THEN 
ALFA  =  l.OE-06 
END  IF 

FL  »  0.5  *  (l.-ALFA) 


mapint.for 


c 


c 


c 


c 


c 


c 


c 


c 


c 

c 


c 


DO  100  I 

ARX 

TARX 


1,15 

ARGUMENTS  OF  BESSEL  FUNCTIONS 
ZE(I) /R^RHO 
ZO(I) /R*RHO 


ARZ  -  ZE(I)/R*Z 
TARZ  -  ZO(I)/R*Z 


FLZX  =  ALFA  *  ARZ 
FLZY  -  ALFA  *  TARZ 


EX  -0.0 
TEX  -  0.0 

IF< (ARZ.LT.170. ) .AND. (TARZ . LT. 170. ))  THEN 
EX  -  EXP  (-ARZ) 

TEX  -  EXP (-TARZ) 


EX  -  EX  *  FL  *  AX(I) 
TEX  -  TEX  *  FL  *  BX(I) 
END  IF 


FLEX  -  0.0 
FLEY  -  0.0 

IF  ( (FLZX. LT. 170. ) .AND. (FLZY. LT. 170. ) )  THEN 
FLEX  -  EXP (-FLZX) 

FLEY  -  EXP (-FLZY) 

END  IF 


FLEX  -  FLEX  *  ALFA  *  AX (I) 

FLEY  -  FLEY  *  ALFA  *  BX(I) 

BO  -  1.0 
B1  -0.0 
B2  -0.0 
TBO  -  1.0 
TBl  -  0.0 

IF(ABS(RHO) .GE.l.OE-06)  THEN 

GET  BESSEL  FUNCTION 
BO  -  BFJO (ARX) 

B1  -  BFJl (ARX) 

B2  -  BFJ2 (B1,B0,ARX) 

TBO  -  BFJO (TARX) 

TBl  -  BFJl (TARX) 

END  IF 

HHR  =  HHR  +  (B0-B2)  *  (FLEX  +  EX) 


MAP37690 

MAP37700 

MAP37710 

MAP37720 

MAP37730 

MAP37740 

MAP37750 

MAP37760 

MAP37770 

MAP37780 

MAP37790 

MAP37800 

MAP37810 

MAP37820 

MAP37830 

MAP37840 

MAP37850 

MAP37860 

MAP37870 

MAP37880 

MAP37890 

MAP37900 

MAP37910 

MAP37920 

MAP37930 

MAP37940 

MAP37950 

MAP37960 

MAP37970 

MAP37980 

MAP37990 

MAP3800C 

MAP38010 

MAP38020 

MAP38030 

MAP38040 

MAP38050 

MAP38060 

MAP38070 

MAP38080 

MAP38090 

MAP38100 

MAP38110 

MAP38120 

MAP38130 

MAP38140 

MAP38150 

MAP38160 

MAP38170 

MAP38180 

MAP38190 

MAP38200 

MAP38210 

MAP38220 

MAP38230 

MAP38240 

MAP38250 

MAP38260 

MAP38270 

MAP38280 

MAP38290 

MAP38300 

MAP38310 

MAP38320 


oo  n  ooonoooooonoooo  o  o  oo 


mapint.for 


HHP 

-  HHP 

+ 

HHZ 

-  HHZ 

+ 

THR 

-  THR 

+ 

THZ 

-  THZ 

+ 

(B0+B2) 

2.*B1 


(FLEX  +  EX) 
(FLEX /ALFA  + 


EX) 


TBl  *  (FLEY  +  TEX) 
TBO  *  (FLEY /ALFA  + 


TEX) 


100  CONTINUE 


SUPERPOSITION  OF 
HHR  -  HHR»CSPS’*CSPH 
HHP  =  HHP*CSPS*  SNPH 
HHZ  -  HHZ*CSPS*CSPH 
THR  =  THR*SNPS 
THZ  =  THZ*SNPS 


HHR  -  +HHR  -THR 
HHP  -  -HHP 
HHZ  -  -HHZ  -THZ 

RETURN 

END 

SUBROUTINE  VACTA (Z, RR, HHR, HHZ,  HHP) 


0  AND  90  DEGREE  TILT  CASES 


VACTA 


PURPOSE- 


INPUT- 

OUTPUT- 

VARIABLES- 


MAP38330 

MAP38340 

MAP38350 

MAP38360 

MAP38370 

MAP38380 

MAP38390 

MAP38400 

MAP38410 

MAP38420 

MAP38430 

MAP38440 

MAP3845C 

MAP38460 

MAP38470 

MAP38480 

MAP38490 

MAP38500 

MAP38510 

MAP38520 

MAP38530 

MAP38540 

MAP38550 

MAP38560 

MAP38570 

MAP38580 

MAP38590 


CALCULATE  NIGHTSIDE  (ZV>0)  VACUUM  FIELD  COMPONENTS  OF 
TAIL  SOLUTION  FROM  POTENTIAL  5.26  REFl .  SOLUTION 
INCLUDES  DIPOLE  PLUS  CHAPMAN-FERRARO .  FIRST  CALLED  ON 
SECOND  ITERATION  AS  FIRST  ITER.  HAS  ANALYTIC  COEFFICIENTMAP38600 
Z,RR  Z  AND  RHO  OF  CYLINDRICAL  SYSTEM  MAP38610 

HHR, HHZ, HHP  FIELD  COMPONENTS  IN  CYLINDRICAL  SYSTEM  MAP38620 
ZE,ZO  ZEROS  OF  DERIVATIVES  OF  BESSELS  J1  AND  JO  MAP38630 

AX,BX  COEFFICIENTS  OF  FOURIER-BESSEL  SERIES  FROM  TAILCOMAP38640 


5.24  AND  5.25  REFl 
R,  RADIUS  OF  TAIL 
SNPS,CSPS  SIN  AND  COS  OF  PSI, 
SNPH, SNPH  SIN  AND  COS  OF  PHI, 


COMMON  /BLOCKl/  B,R,Q,PI,PSI 
COMMON  /BLOCK2/  ZE (20) , AX (20) , ZO (20) , BX (20) 
COMMON  /BLOCK5/CSPH, SNPH, QCS, QSN, CSPS, SNPS 
COMMON  /BLOCK6/  CT,ST 

HHR  -  0.0 
HHZ  -  0.0 
HHP  -  0.0 
THR  =0.0 
THZ  -  0,0 
D  -  l.OE-02 


DO  100  I 

ARX  « 
ARZ  » 
TARX 
TARZ 

EX  ■ 
TEX  - 


■  1,15 

ARGUMENTS 
ZE (I) /R*RR 
ZE(I) /R*Z 
'  ZO(I) /R*RR 

■  ZO(I) /R*Z 

0.0 

0.0 


FOR  BESSEL  FUNCTIONS 


IF( (ARZ.LT.170. ) .AND. (TARZ . LT. 1 70 . ) ) 
EX  -  EXP ( -ARZ) 

EX  =  EX* AX  (I) 


MAP38650 

MAP38660 

THE  DIPOLE  TILT  ANGLE  MAP38670 
A  CYLINDRICAL  COORDINATE  MAP38680 

MAP38690 
MAP38700 
MAP38710 
MAP38720 
MAP38730 
MAP38740 
MAP38750 
MAP38760 
MAP38770 
MAP38780 
MAP38790 
MAP38800 
MAP38810 
MAP38820 
MAP38830 
MAP38840 
MAP38850 
MAP38860 
MAP38870 
MAP38880 
MAP38890 
MAP38900 
MAP38910 
MAP38920 
MAP38930 
MAP38940 
MAP38950 
MAP38960 


THEN 


OO  OO  OOOOOOOOOO  O  o  oo 


mapint.for 


BO 

B1 

B2 

TBO 

TBl 

END  IF 


BFJO (ARX) 

BFJl (ARX) 

BFJ2 (B1,B0,ARX) 
BFJO (TARX) 

BFJl (TARX) 


(B0-B2) *EX 
(B0+B2) *EX 
2.0*B1*EX 


THR  =  THR 
THZ  -  THZ 


CONTINUE 


X  »  EXP(-TARZ)  MAP38970 

X  =  TEX*BX(I)  MAP38980 

MAP38990 
MAP39000 

1.0  MAP39010 

0.0  MAP39020 

0.0  MAP39030 

1.0  MAP39040 

0.0  MAP39050 

MAP39060 

1F(ABS(RR) .GE.l.OE-06)  THEN  MAP39070 

-BFJO (ARX)  MAP39080 

=  BFJl (ARX)  MAP39090 

-  BFJ2 (B1,B0,ARX)  MAP39100 

10  -  BFJO  (TARX)  MAP39110 

11  -  BFJl  (TARX)  MAP39120 

MAP39130 
MAP39140 

HHR  +  (B0-B2)*EX  MAP39150 

HHP  +  (B0+B2)*EX  MAP39160 

HHZ  +  2.0*B1*EX  MAP39170 

MAP39180 

THR  +  TB1*TEX  MAP39190 

THZ  +  TB0*TEX  MAP39200 

MAP39210 
MAP39220 

SUPERIMPOSE  0  AND  90  DEGREE  TILT  CASES  MAP39230 

CSPS*CSPH  MAP39240 

CSPS*  SNPH  MAP39250 

CSPS^CSPH  MAP39260 

SNPS  MAP39270 

SNPS  MAP39280 

MAP39290 
MAP39300 

-THR  MAP39310 

MAP39320 

-THZ  MAP39330 

MAP39340 
MAP39350 
MAP39360 

*********************;  TAPOT  MAP39370 

TAPOT(NDIM)  MAP39380 

MAP39390 

GET  SUM  OF  CHAPMAN-FERRARO  AND  DIPOLE  POTENTIALS  AT  NDIMMAP39400 


SUPERIMPOSE 
HHR*CSPS*CSPH 
HHP*CSPS*  SNPH 
HHZ*CSPS*CSPH 
THR* SNPS 
THZ*SNPS 


+HHR  -THR 
-HHP 

-HHZ  -THZ 


90  DEGREE  TILT  CASES 


RETURN 

END 

SUBROUTINE  TAPOT (NDIM) 


PURPOSE- 


LOCATIONS  ON  THE  CYLINDER  CAP  2V=0 
INPUT-  NDIM,  NUMBER  OF  GRID  POINTS  FOR  INTEGRATION 

OUTPUT-  Wl,WO  SUM  OF  POTENTIALS  FOR  TILTS  0  AND  90  DEGREE 

OUTPUT  IS  POTENTIAL* (1 /DIPOLE  MOMENTO 
VARIABLES-  HS,  GRID  SIZE 

R,  RADIUS  OF  TAIL 

X,  RADIAL  POSITIONS  OF  GRID  POINTS 
COMMON  /BLOCK8/  W1 (1001) , WO (1001) 

COMMON  /BLOCK9/  X(lOOl) ,Y1 (1001) ,Y0 (1001) , Z1 (1001) , ZO (1001) , 
COMMON  /BLOCKl/  B,  R,  Q,  PI,  PSI 

GENERATE  GRID  POINTS  ON  CYLINDER  CAP 

X(l)  -  0.0 

HS  -  R/FLOAT(NDIM-l) 

DO  1  1-2,  NDIM 

X(I)  -  FLOAf(I-l)  *  HS 
CONTINUE 


GET  POTENTIALS  OF  CHAPMAN-FERRARO  TILT 


MAP39410 
MAP39420 
EGREE  MAP39430 

MAP39440 
MAP39450 
MAP39460 
MAP39470 
MAP39480 
MAP39490 
001),  HS  MAP39500 
MAP39510 
MAP39520 
MAP39530 
MAP39540 
MAP39550 
MAP39560 
MAP39570 
MAP39580 
MAP39590 
90  DEGREES  MAP39600 


mapint.for 


EQ.  5.18-5.20  REFl  MAP39610 

DO  2  1=1,  NDIM  MAP39620 

CALL  CFPOT(X(I) ,POT1,POTO)  MAP39630 

W1(I)  =  POTl  MAP39640 

WO (I)  =  POTO  MAP39650 

CONTINUE  MAP39660 

MAP39670 

GET  POTENTIALS  OF  DIPOLE, TILT  0  AND  90  DEGREES  5.17  REF1MAP39680 


DO  3  1=1,  NDIM 

CALL  DIPOT (X (I) , POTl, POTO) 


W1(I) 
WO  (I) 
CONTINXre: 


RETURN 

END 


W1  (I) 
W0<I) 


SUBROUTINE  CFPOT (RR, POTl, POTO) 


CFPOT 


PURPOSE-  CALCULATE  CHAPMAN-FERRARO  POTENTIAL  FOR  A  POINT  AT  THE  MAP39810 

CYLINDER  LID,  ZV=0 .  USES  5.11  WITH  THETA=90  DEGREES,  MAP39820 
EQUIVALENT  TO  5.18-5.20  REFl.  BOTH  TILT  CASES  0  AND  90  MAP39830 

DEGREES  DONE.  MAP39840 

INPUT-  RR,  RHO  IN  CYLINDRICAL,  DISTANCE  FROM  TAIL  AXIS  MAP39850 

OUTPUT-  POTl,  POTENTIAL  FOR  0  DEGREE  TILT  CASE  MAP39860 

POTO,  POTENTIAL  FOR  90  DEGREE  TILT  CASE  MAP39870 

OUTPUT  IS  ACTUALLY  POTENTIAL* (-1 /DIPOLE  MOMENT)  MAP39880 
VARIABLES-  QR,  DIPOLE  MOMENT  MAP39890 

Pl,PO  LEGENDRE  POLYNOMIAL  TERMS  FOR  M-1  AND  0,  RESPECT.  MAP39900 
Gl,GO  COEFFICIENTS  OF  LEGENDRE  TERMS,  M=1  AND  0  RESPECT. MAP39910 


MAP39690 

MAP39700 

MAP39710 

MAP39720 

MAP39730 

MAP39740 

MAP39750 

MAP39760 

MAP39770 

MAP39780 

MAP39790 

MAP39800 

MAP39810 

MAP39820 

MAP39830 

MAP39840 

MAP39850 

MAP39860 

MAP39870 

MAP39880 

MAP39890 


R,  RADIUS  OF  TAIL 

COMMON  /BLOCKl/  B,  R,  Q,  PI,  PSI 
COMMON  /CHABLO/  Gl(20),  GO (20) 

DIMENSION  PO  (21) ,  PI  (21) 

LEGENDRE  TERMS  WITH  THETA=90  DEGREES 
P0(2)  =  -  0.5 
PI  (1)  =+  1.0 
Pl(3)  =  3.*P0(2) 


DO  1  NY  =  2,  10 

EVERY  OTHER  TERM  IS  ZERO,  RECURRENCE  RELATION  USED 
SUBROUT.  LEGEN  NOT  CALLED 
ZFNY  «  2. ‘FLOAT (NY) 

FAKNY  -  (ZFNY-1 . ) /ZFNY 

P0(2*NY)  -  -  P0{2*NY-2)  *  FAKNY 

P1(2*NY+1)  -  +  (ZFNY+1.)  *  P0{2*NY) 

CONTINUE 

TILT  -  0  DEGREES  CASE 

RRP  ■  RR 

RP  «  (RR*RR) / (R*R) 


Gl(l)  *  Pl(l) 


DO  2  NY 
ZFE  - 
RRP  « 
POTl 
CONTINUE 


-  1,  9 

FLOAT {2*NY+1) 

RRP  *  RP 

-  POTl  +  G1(2*NY+1)  *  P1(2*NY+1) 


MAP39920 

MAP39930 

MAP39940 

MAP39950 

MAP39960 

MAP39970 

MAP39980 

MAP39990 

MAP40000 

MAP40010 

MAP40020 

MAP40030 

MAP40040 

MAP40050 

MAP40060 

MAP400‘’0 

MAP40080 

MAP40090 

MAP40100 

MAP40110 

MAP40120 

MAP40130 

MAP40140 

MAP40150 

MAP40160 

MAP40170 

MAP40180 

MAP40190 

MAP40200 

MAP40210 

MAP40220 

MAP40230 

MAP40240 


mapint.for 


c 

c 


c 

c 


QR  =  Q  *  (R**3) 

POTl  -  -POTl/QR 

TILT  =  90  DEGREE  CASE 

RRP  =  R 

RP  =  (RR*RR) / (R*R) 

POTO  =0.0 

DO  3  NY  =  1,  10 

ZFE  =  FLOAT(2*NY) 

RRP  =  RRP  *  RP 

POTO  =  POTO  +  G0(2*NY)  *  P0(2*NY)  *  RRP  /  ZFE 
CONTINUE 


QR  =  Q  *  (R**3) 

POTO  =  -POTO/QR 

RETURN 

END 

*************<(*********************; 
SUBROUTINE  DIPOT (RR, POTl, POT2) 


DIPOT 


C 

C 

C 

C 

C 

C 

C 

C 


PURPOSE-  CALCULATE  DIPOLE  POTENTIAL  AT  LID  OF  CYLINDER  USING  5 
REFl  FOR  TILT  0  AND  90  DEGREE  CASES 
INPUT-  RR,  RHO  IN  CYLINDRICAL,  DISTANCE  FROM  TAIL  AXIS 

B,  =  RADIUS  MINUS  STAND-OFF  DISTANCE 
OUTPUT-  POT1,POT2  DIPOLE  POTENTIAL  FOR  TILT  0  AND  90  DEGREES 

OUTPUT  IS  POTENTIAL* (-1/DIPOLE  MOMENT) 

COMMON  /BLOCKl/  B,  R,  Q,  PI,  PSI 

RRB  =  SQRT(RR*RR  +  B*B) 

RRB  =  RRB**3 

POTl  =  +  RR  /  RRB 
POT2  =  +  B  /  RRB 

RETURN 

END 


MAP40250 

MAP40260 

MAP40270 

MAP40280 

MAP40290 

MAP40300 

MAP40310 

MAP40320 

MAP40330 

MAP40340 

MAP40350 

MAP40360 

MAP40370 

MAP40380 

MAP40390 

MAP40400 

MAP40410 

MAP40420 

MAP40430 

MAP40440 

MAP40450 

MAP40460 

MAP40470 

MAP40480 

.17MAP40490 

MAP40500 

MAP40510 

MAP40520 

MAP40530 

MAP40540 

MAP40550 

MAP40560 

MAP40570 

MAP40580 

MAP40590 

MAP40600 

MAP40610 

MAP40620 

MAP40630 

MAP40640 

MAP40650 


Appendix  E 


1 


MSM  Reference  List:  Correlation  Studies 


Compiled  by  R.  V.  Hilmer.  Reference  numbers  correspond  to  the  numbers  on  associated 
source  chart.  Note  that  "*author"  means  copy  available 


No. 

First  Author 

Source 

10 

Akasofu,  S.-I. 

Magnetospheric  Substorms:  A  Model,  in  Solar- Terr.Physics  Part 
3,  ed.  Dyer,  131-151,  D.  Rcidel,  1972 

20 

Akasofu,  S.-I. 

Physics  of  Magnetospheric  Substorms,  Reidel,  1977 

30 

Akasofu,  S.-I. 

Interplanetary  Energy  Flux  Associated  with  Magnetospheric 
Substorms,  PSS,  27,  425,  1979 

40 

Akasofu,  S.-I. 

Relationships  Between  the  AE  and  Dst  Indices  During 
Geomagnetic  Storms,  JGR,  86,  4820-4822,  1981 

50 

Akasofu,  S,-I. 

Dependence  of  the  Geometry  of  the  Region  of  Open  Field 

Lines  on  the  Interplanetary  Magnetic  Field,  PSS,  29,  803,  1981 

60 

Akasofu,  S.-I. 

Energy  Coupling  Between  the  Solar  Wind  and  the 
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